From eea7139726630f86d13aed80740f8586b7cdaeab Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Wed, 21 May 2025 13:46:38 +0200 Subject: [PATCH] update annotate --- .../annotate-autoloads.el | 0 .../annotate-pkg.el | 8 +- .../annotate.el | 996 ++++++++++-------- 3 files changed, 538 insertions(+), 466 deletions(-) rename elpa/{annotate-20241017.1508 => annotate-20250515.1428}/annotate-autoloads.el (100%) rename elpa/{annotate-20241017.1508 => annotate-20250515.1428}/annotate-pkg.el (64%) rename elpa/{annotate-20241017.1508 => annotate-20250515.1428}/annotate.el (84%) diff --git a/elpa/annotate-20241017.1508/annotate-autoloads.el b/elpa/annotate-20250515.1428/annotate-autoloads.el similarity index 100% rename from elpa/annotate-20241017.1508/annotate-autoloads.el rename to elpa/annotate-20250515.1428/annotate-autoloads.el diff --git a/elpa/annotate-20241017.1508/annotate-pkg.el b/elpa/annotate-20250515.1428/annotate-pkg.el similarity index 64% rename from elpa/annotate-20241017.1508/annotate-pkg.el rename to elpa/annotate-20250515.1428/annotate-pkg.el index c1fb8e71..3aa255ac 100644 --- a/elpa/annotate-20241017.1508/annotate-pkg.el +++ b/elpa/annotate-20250515.1428/annotate-pkg.el @@ -1,9 +1,9 @@ ;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "annotate" "20241017.1508" +(define-package "annotate" "20250515.1428" "Annotate files without changing them." - () + '((emacs "27.1")) :url "https://github.com/bastibe/annotate.el" - :commit "c5a41ce5ac861e3fcd95669eb68c886ce702d39b" - :revdesc "c5a41ce5ac86" + :commit "dc6e884265c9de5b0e486b9f6bd9509a14b85c94" + :revdesc "dc6e884265c9" :maintainers '(("Bastian Bechtold" . "bastibe.dev@mailbox.org") ("cage" . "cage-dev@twistfold.it"))) diff --git a/elpa/annotate-20241017.1508/annotate.el b/elpa/annotate-20250515.1428/annotate.el similarity index 84% rename from elpa/annotate-20241017.1508/annotate.el rename to elpa/annotate-20250515.1428/annotate.el index 9ff8eae3..090a9072 100644 --- a/elpa/annotate-20241017.1508/annotate.el +++ b/elpa/annotate-20250515.1428/annotate.el @@ -7,8 +7,9 @@ ;; Maintainer: Bastian Bechtold , cage ;; URL: https://github.com/bastibe/annotate.el ;; Created: 2015-06-10 -;; Package-Version: 20241017.1508 -;; Package-Revision: c5a41ce5ac86 +;; Package-Version: 20250515.1428 +;; Package-Revision: dc6e884265c9 +;; Package-Requires: ((emacs "27.1")) ;; This file is NOT part of GNU Emacs. @@ -59,7 +60,7 @@ ;;;###autoload (defgroup annotate nil "Annotate files without changing them." - :version "2.2.3" + :version "2.4.2" :group 'text) (defvar annotate-mode-map @@ -86,13 +87,13 @@ See https://github.com/bastibe/annotate.el/ for documentation." :type 'file) (defcustom annotate-file-buffer-local nil - "If non nil (default `nil'), for each annotated file `filename', a database -`filename.notes', containing the annotations, is generated in the -same directory that contains `filename'." + "If non nil (default `nil'), for each annotated file \"filename\", a database +\"filename.notes\", containing the annotations, is generated in the +same directory that contains \"filename\"." :type 'string) (defcustom annotate-buffer-local-database-extension "notes" - "The extension appended to the annotated filename to get the + "The extension appended to the annotated filename to get the name of the local database annotation" :type 'string) @@ -100,17 +101,17 @@ name of the local database annotation" (:underline "#92EEF1") (:underline "#F192EE")) "List of faces for annotated text." - :type 'list) + :type '(repeat (plist))) (defcustom annotate-annotation-text-faces '((:background "#EEF192" :foreground "black") (:background "#92EEF1" :foreground "black") (:background "#F192EE" :foreground "black")) "List of faces for annotation's text." - :type 'list) + :type '(repeat (plist))) (defface annotate-prefix '((t (:inherit default))) - "Face for character used to pad annotation. + "Face for character used to pad annotation. This is the fill space between text lines and annotation text.") (defcustom annotate-annotation-column 85 @@ -118,10 +119,10 @@ This is the fill space between text lines and annotation text.") :type 'number) (defcustom annotate-diff-export-options "" - "Options passed to `diff' in `annotate-export-annotations'. + "Options passed to \"diff\" in `annotate-export-annotations'. This is used when diffing between a buffer with and without integrated annotations. -Note that there is an implicit `-u' at the end of default options +Note that there is an implicit \"-u\" at the end of default options that Emacs passes to the diff program." :type 'string) @@ -143,7 +144,7 @@ annotated indirect buffer." :type 'character) (defcustom annotate-fallback-comment "#" - "When variable `COMMENT-START' is nil use this string instead." + "When variable `comment-start' is nil use this string instead." :type 'string) (defcustom annotate-blacklist-major-mode '() @@ -155,36 +156,36 @@ will be never loaded, see `annotate-initialize-maybe'." :type '(repeat symbol)) (defcustom annotate-summary-ask-query t - "If non nil a prompt asking for a query to filter the database + "If non nil a prompt asking for a query to filter the database before showing it in a summary window is used. If nil the database is not filtered at all." :type 'boolean) (defcustom annotate-database-confirm-deletion t - "If non nil a prompt asking confirmation before deleting a + "If non nil a prompt asking confirmation before deleting a database file that is going to be empty after saving an annotated file will be shown." :type 'boolean) (defcustom annotate-annotation-confirm-deletion nil - "If non nil a prompt asking confirmation before deleting an + "If non nil a prompt asking confirmation before deleting an annotation file will be shown." :type 'boolean) (defcustom annotate-database-confirm-import t - "If non nil a prompt asking confirmation before importing a + "If non nil a prompt asking confirmation before importing a database file will be shown." :type 'boolean) (defcustom annotate-annotation-max-size-not-place-new-line 15 - "The maximum \"string-width\" allowed for an annotation to be + "The maximum \"string-width\" allowed for an annotation to be placed on the right margin of the window instead of its own line after the annotated text." :type 'number) (defconst annotate-allowed-positioning-policy '(:by-length :margin :new-line) - "The allowed values for annotation positioning") + "The allowed values for annotation positioning.") (defcustom annotate-annotation-position-policy :by-length "Policy for annotation's position: @@ -196,16 +197,16 @@ placed on the right margin of the window instead of its own line decide by text's length if the length is more than the value of -`ANNOTATE-ANNOTATION-MAX-SIZE-NOT-PLACE-NEW-LINE' place the +`annotate-annotation-max-size-not-place-new-line' place the annotation on a new line, place on the right margin otherwise." :type 'symbol) (defcustom annotate-use-echo-area nil - "Whether annotation text should appear in the echo area only when mouse + "Whether annotation text should appear in the echo area only when mouse id positioned over the annotated text instead of positioning them in the the buffer (the default)." - :type 'boolean) + :type 'boolean) (defcustom annotate-print-annotation-under-cursor nil "Whether annotation text should appear in the minibuffer when @@ -221,14 +222,14 @@ annotate-print-annotation-under-cursor is non nil" :type 'string) (defcustom annotate-print-annotation-under-cursor-delay 0.5 - "The delay (in seconds) after an annotation id printed in the + "The delay (in seconds) after an annotation id printed in the minibuffer, when the pursor is placed over an annotated text. This variable works only if `annotate-print-annotation-under-cursor' is non nil" :type 'float) (defcustom annotate-warn-if-hash-mismatch t - "Whether a warning message should be printed if a mismatch + "Whether a warning message should be printed if a mismatch occurs, for an annotated file, between the hash stored in the database annotations and the hash calculated from the actual file. @@ -239,19 +240,44 @@ has been modified outside Emacs." :type 'boolean) (defcustom annotate-endline-annotate-whole-line t - "Whether trying to annotate the end of line character will + "Whether trying to annotate the end of line character will annotate the whole line before (or after if the line is composed by the newline character only) instead." :type 'boolean) (defcustom annotate-search-region-lines-delta 2 - "When the annotated file is out of sync with its annotation + "When the annotated file is out of sync with its annotation database the software looks for annotated text in the region with delta equals to the value of this variable. Units are in number of lines. The center of the region is the position of the annotation as defined in the database." :type 'number) +(defcustom annotate-autosave t + "Whether annotations should be saved after each user action, +e.g. new annotation created, existing one amended or deleted." + :type 'boolean) + +(defcustom annotate-annotation-expansion-map '() + + "The expansion map for the annotation text. If a substring in the +annotation text matches the string in the first item of each element of +this list, it is expanded with the results of passing the second item — +as a command — to a system shell, if the third item is not null, the +output string of the command's results are trimmed (spaces or some +others non printable characters are removed from both ends, see: +`string-trim'). Example below. + +The expression: + +\(setf annotate-annotation-expansion-map + \\='((\"%d\" \"date +%Y-%m-%d\" t))) + +Will expand any occurrence of \"%d\" in the annotation's text with the +current date (format: \"YYYY-MM-DD\"), moreover the results will be +trimmed" + :type '(repeat (list string string boolean))) + (defconst annotate-prop-chain-position 'position) @@ -293,13 +319,13 @@ has been killed.") (defconst annotate-error-summary-win-filename-invalid "Error: File not found or in an unsupported format" - "The message to warn the user that file can not be show in + "The message to warn the user that file can not be show in summary window because does not exist or is in an unsupported format.") (defconst annotate-info-valid-file-extensions '(".info" ".info.gz" ".gz") - "The valid extension for files that contains info document.") + "The valid extension for files that contains info document.") (defconst annotate-summary-list-prefix " " "The string used as prefix for each text annotation item in summary window.") @@ -361,36 +387,36 @@ in the customizable colors lists: (define-error 'annotate-error "Annotation error") (define-error 'annotate-empty-annotation-text-error - "Empty annotation text" - 'annotate-error) + "Empty annotation text" + 'annotate-error) (define-error 'annotate-no-new-line-at-end-file-error - "No newline found at the end of the buffer" - 'annotate-error) + "No newline found at the end of the buffer" + 'annotate-error) (define-error 'annotate-db-file-not-found - "Annotations database file not found" - 'annotate-error) + "Annotations database file not found" + 'annotate-error) (define-error 'annotate-annotate-region-overlaps - "Error: the region overlaps with at least an already existing annotation" - 'annotate-error) + "Error: the region overlaps with at least an already existing annotation" + 'annotate-error) (define-error 'annotate-query-parsing-error - "Parsing failed:" - 'annotate-error) + "Parsing failed:" + 'annotate-error) (cl-defmacro annotate-with-disable-read-only (&body body) - "Run `BODY' with `READ-ONLY-MODE' temporary disabled." + "Run BODY with `read-only-mode' temporary disabled." (let ((read-mode-p (gensym))) - `(let ((,read-mode-p (if buffer-read-only - 1 - -1))) - (when (= ,read-mode-p 1) - (read-only-mode -1)) - ,@body - (when (= ,read-mode-p 1) - (read-only-mode 1))))) + `(let ((,read-mode-p (if buffer-read-only + 1 + -1))) + (when (= ,read-mode-p 1) + (read-only-mode -1)) + ,@body + (when (= ,read-mode-p 1) + (read-only-mode 1))))) (defun annotate-annotations-exist-p () "Does this buffer contains at least one or more annotations?" @@ -416,13 +442,13 @@ See `annotate-blacklist-major-mode'." (shutdown)))))) (cl-defun annotate-buffer-checksum (&optional (object (current-buffer))) - "Calculate an hash for the argument `OBJECT'." + "Calculate an hash for the argument OBJECT." (secure-hash 'md5 object)) (defun annotate-end-of-line-pos () - "Get the position of the end of line and rewind the point's + "Get the position of the end of line and rewind the point's position (so that it is unchanged after this function is called)." - (line-end-position)) + (line-end-position)) (defun annotate-beginning-of-line-pos () "Get the position of the beginning of line and rewind the point's @@ -432,70 +458,71 @@ position (so that it is unchanged after this function is called)." (point))) (defun annotate-annotated-text-empty-p (annotation) - "Does this `ANNOTATION' contains annotated text?" + "Does this ANNOTATION contains annotated text?" (= (overlay-start annotation) (overlay-end annotation))) (defun annotate-annotation-set-face (annotation face) - "Set property face to `FACE' for `ANNOTATION'." + "Set property face to FACE for ANNOTATION." (overlay-put annotation 'face face)) (defun annotate-annotation-face (annotation) - "Get property face from `ANNOTATION'." + "Get property face from ANNOTATION." (overlay-get annotation 'face)) (defun annotate-annotation-set-annotation-face (annotation face) - "Set property annotation-face to `FACE' for `ANNOTATION'." + "Set property annotation-face to FACE for ANNOTATION." (overlay-put annotation 'annotation-face face)) (defun annotate-annotation-property-annotation-face (annotation) - "Get property annotation-face from `ANNOTATION'." + "Get property annotation-face from ANNOTATION." (overlay-get annotation 'annotation-face)) (defun annotate-annotation-set-annotation-text (annotation annotation-text) - "Set the annotation's content for `ANNOTATION` to `ANNOTATION-TEXT`." + "Set the annotation's content for ANNOTATION to ANNOTATION-TEXT." (overlay-put annotation 'annotation annotation-text)) (defun annotate-annotation-get-annotation-text (annotation) - "Get the annotation's content for `ANNOTATION`." + "Get the annotation's content for ANNOTATION." (overlay-get annotation 'annotation)) (defun annotate-annotation-set-position (annotation position) - "Set the annotation's position policy for `ANNOTATION` to the value bound to `POSITION`." + "Set the annotation's position policy for ANNOTATION +to the value bound to POSITION." (overlay-put annotation 'annotate-position position)) (defun annotate-annotation-get-position (annotation) - "Get the annotation's position policy for `ANNOTATION`." + "Get the annotation's position policy for ANNOTATION." (overlay-get annotation 'annotate-position)) (defun annotate-overlay-maybe-set-position (overlay position) - "Set the annotation's position policy for `ANNOTATION` to the value bound to `POSITION`, -but only if the value of the property 'position is not null." + "Set the annotation's position policy for OVERLAY to the value bound +to POSITION,but only if the value of the property `position' is not null." (when position (annotate-annotation-set-position overlay position))) (defun annotate-chain-last-ring (chain) - "Get the last ring of `CHAIN'." + "Get the last ring of CHAIN." (car (last chain))) (defun annotate--remap-chain-pos (annotations) - "Remap `ANNOTATIONS' as an annotation \"chain\". + "Remap ANNOTATIONS as an annotation \"chain\". An annotation is a collection of one or more overlays that -contains the property `ANNOTATE-PROP-CHAIN-POSITION'. +contains the property `annotate-prop-chain-position'. -The value of `ANNOTATE-PROP-CHAIN-POSITION' in each chain is an +The value of `annotate-prop-chain-position' in each chain is an integer starting from: -`ANNOTATE-PROP-CHAIN-POS-MARKER-FIRST' and *always* ending with +`annotate-prop-chain-pos-marker-first' and *always* ending with -`ANNOTATE-PROP-CHAIN-POS-MARKER-LAST' +`annotate-prop-chain-pos-marker-last' This means that a value of said property for a chain that contains only an element is equal to -`ANNOTATE-PROP-CHAIN-POS-MARKER-LAST'. +`annotate-prop-chain-pos-marker-last'. -This function ensure this constrains for the chain `ANNOTATION' +This function ensure this constrains for the chain ANNOTATION belong." (cond ((< (length annotations) @@ -521,24 +548,24 @@ 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)." (with-silent-modifications - (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)) - ;; check if we are breaking the overlay - (when (<= (overlay-start overlay) - a - (overlay-end overlay)) - (let ((start-overlay (overlay-start overlay))) - ;; delete overlay if there is no more annotated text - (when (<= a start-overlay) - (let ((chain (cl-remove overlay (annotate-find-chain overlay)))) - (delete-overlay overlay) - (annotate--remap-chain-pos chain)))))))))) + (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)) + ;; check if we are breaking the overlay + (when (<= (overlay-start overlay) + a + (overlay-end overlay)) + (let ((start-overlay (overlay-start overlay))) + ;; delete overlay if there is no more annotated text + (when (<= a start-overlay) + (let ((chain (cl-remove overlay (annotate-find-chain overlay)))) + (delete-overlay overlay) + (annotate--remap-chain-pos chain)))))))))) (defun annotate-info-select-fn () "The function to be called when an info buffer is updated." @@ -548,17 +575,17 @@ modified (for example a newline is inserted)." (defun on-window-size-change (_frame) "The function to call when window-size-change-functions is called, -note that the argument `FRAME' is ignored" +note that the argument _FRAME is ignored" (font-lock-flush)) (defun annotate--filepath->local-database-name (filepath) - "Generates the file path of the local database form `FILEPATH'." + "Generates the file path of the local database form FILEPATH." (concat (file-name-nondirectory filepath) "." annotate-buffer-local-database-extension)) (defun annotate--maybe-database-set-buffer-local () - "Sets, if user asked to do so, the annotation database to a + "Sets, if user asked to do so, the annotation database to a local version (i.e. a different database for each annotated file" (when annotate-file-buffer-local (make-local-variable 'annotate-file) @@ -575,7 +602,7 @@ See also the customizable variables: `annotate-echo-annotation-timer' and `annotate-print-annotation-under-cursor'." (with-current-buffer (current-buffer) (when annotate-mode - (when-let ((annotation (annotate-annotation-at (point)))) + (when-let* ((annotation (annotate-annotation-at (point)))) (message "%s%s" annotate-print-annotation-under-cursor-prefix (annotate-annotation-get-annotation-text annotation)))))) @@ -643,22 +670,22 @@ Used when the mode is deactivated." (1 (annotate--change-guard))))))) (defun annotate-overlay-filled-p (overlay) - "Does this `OVERLAY' contains an \"annotation\" property?" + "Does this OVERLAY contains an `annotation' property?" (and overlay (overlayp overlay) (annotate-annotation-get-annotation-text overlay))) (defun annotationp (overlay) - "Is `OVERLAY' an annotation?" + "Is OVERLAY an annotation?" (annotate-overlay-filled-p overlay)) (cl-defmacro annotate-ensure-annotation ((overlay) &body body) - "Runs `BODY' only if `OVERLAY' is an annotation (i.e. passes annotationp)." + "Runs BODY only if OVERLAY is an annotation (i.e. passes annotationp)." `(and (annotationp ,overlay) (progn ,@body))) (defun annotate--position-on-annotated-text-p (pos) - "Does `POS' (as buffer position) corresponds to a character + "Does POS (as buffer position) corresponds to a character that belong to some annotated text?" (let ((annotation (annotate-annotation-at pos))) (if annotation @@ -712,20 +739,43 @@ that belong to some annotated text?" (defun annotate-delete-chains-in-region (from to) "Deletes all the chains enclosed in the range specified by -positions `FROM' and `TO'." +positions FROM and TO." (let* ((enclosed-chains (annotate-annotations-chain-in-range from to))) (dolist (chain enclosed-chains) (annotate--delete-annotation-chain (cl-first chain))))) (defun annotate-count-newline-in-region (from to) - "Counts the number of newlines character (?\n) in range -specified by `FROM' and `TO'." + "Counts the number of newlines character (?\n) in range +specified by FROM and TO." (cl-count-if (lambda (a) (char-equal a ?\n)) (buffer-substring-no-properties from to))) +(defun annotate--expand-annotation-text (annotation-text) + "Expand substrings of ANNOTATION-TEXT, using rules defined in the variable in +`in annotate-annotation-expansion-map'." + (cl-flet ((regex (expansion-item) + (cl-first expansion-item)) + (trimp (expansion-item) + (cl-third expansion-item)) + (command (expansion-item) + (cl-second expansion-item))) + (cl-loop with results = annotation-text + for expansion in annotate-annotation-expansion-map + when (string-match-p (regex expansion) results) + do (let ((expansion-results (shell-command-to-string (command expansion)))) + (when (trimp expansion) + (setf expansion-results (string-trim expansion-results))) + (setf results + (replace-regexp-in-string (regex expansion) + expansion-results + results + t + t))) + finally (return results)))) + (defun annotate-annotate (&optional color-index) "Create, modify, or delete annotation. -if `COLOR-INDEX' is not null must be an index that adresses an element both in +if COLOR-INDEX is not null must be an index that adresses an element both in - `annotate-highlight-faces' and - `annotate-annotation-text-faces'" @@ -737,7 +787,8 @@ and ;; create a new annotation in the region returned by `annotate-bound' (cl-destructuring-bind (start end) (annotate-bounds) - (let ((annotation-text (read-from-minibuffer annotate-annotation-prompt))) + (let* ((raw-text (read-from-minibuffer annotate-annotation-prompt)) + (annotation-text (annotate--expand-annotation-text raw-text))) (condition-case nil (annotate-create-annotation start end annotation-text nil color-index) (annotate-no-new-line-at-end-file-error @@ -883,11 +934,13 @@ and (if (/= eol bol) ; text before the newline, annotate it (annotate-line eol) (progn ; no text before the new - ; line, annotate next line - ; with proper text + ; line, annotate next line + ; with proper text (forward-line 1) (goto-char (annotate-end-of-line-pos)) - (annotate-annotate))))))))))))))) + (annotate-annotate)))))))))))) + (when annotate-autosave + (annotate-save-annotations))))) (defun annotate-toggle-annotation-text () "Hide annotation's text at current cursor's point, if such annotation exists." @@ -900,7 +953,7 @@ and (font-lock-flush))) (defun annotate-toggle-all-annotations-text () -"Hide annototation's text in the whole buffer." + "Hide annotation's text in the whole buffer." (interactive) (let ((chains (annotate-annotations-chain-in-range 0 (buffer-size)))) (dolist (chain chains) @@ -958,15 +1011,15 @@ and (defun annotate-change-annotation-text-position () "Change the policy positioning for the annotation under point." (interactive) - (when-let ((annotation (annotate-annotation-at (point)))) + (when-let* ((annotation (annotate-annotation-at (point)))) (let ((current-position (annotate-annotation-get-position annotation))) (if (null current-position) (annotate-annotation-set-position annotation (cl-first annotate-allowed-positioning-policy)) - (when-let ((current-position-index (cl-position current-position - annotate-allowed-positioning-policy)) - (next-position-index (mod (1+ current-position-index) - (length annotate-allowed-positioning-policy)))) + (when-let* ((current-position-index (cl-position current-position + annotate-allowed-positioning-policy)) + (next-position-index (mod (1+ current-position-index) + (length annotate-allowed-positioning-policy)))) (annotate-annotation-set-position annotation (elt annotate-allowed-positioning-policy next-position-index))))) @@ -983,20 +1036,20 @@ and (let* ((current-color-index (cl-position-if (lambda (a) (cl-equalp current-annotation-face a)) - annotate-annotation-text-faces)) + annotate-annotation-text-faces)) (new-color-index (mod (1+ current-color-index) (length annotate-annotation-text-faces)))) new-color-index) 0)))) - (when-let ((annotation (annotate-annotation-at (point)))) - (let ((new-color-index (new-color-index annotation))) - (annotate-annotation-set-annotation-face annotation - (elt annotate-annotation-text-faces - new-color-index)) - (annotate-annotation-set-face annotation - (elt annotate-highlight-faces - new-color-index)) - (font-lock-flush))))) + (when-let* ((annotation (annotate-annotation-at (point)))) + (let ((new-color-index (new-color-index annotation))) + (annotate-annotation-set-annotation-face annotation + (elt annotate-annotation-text-faces + new-color-index)) + (annotate-annotation-set-face annotation + (elt annotate-highlight-faces + new-color-index)) + (font-lock-flush))))) (defun annotate-actual-comment-start () "String for comment start related to current buffer's major @@ -1016,7 +1069,7 @@ major mode." (string-width (annotate-actual-comment-end)))) (defun annotate-wrap-in-comment (&rest strings) - "Put comment markers at the start and (if it makes sense) + "Put comment markers at the start and (if it makes sense) end of a string. See: annotate-actual-comment-start and annotate-actual-comment-end." (apply #'concat (append (list (annotate-actual-comment-start)) @@ -1149,13 +1202,13 @@ annotation, and can be conveniently viewed in diff-mode." - the area between the overlay and the annotation - the newline that will display the annotation -The first match will get `ANNOTATE--CHANGE-GUARD' as its -`INSERT-IN-FRONT-HOOK', to make sure that if a newline is inserted +The first match will get `annotate--change-guard' as its +`insert-in-front-hook', to make sure that if a newline is inserted between the overlay and the annotation, the \"display\" property of the newline is properly disposed of. -The second match will get `ANNOTATE--ANNOTATION-BUILDER' as its -\"display\" property, which makes the newline look like an +The second match will get `annotate--annotation-builder' as its +`display' property, which makes the newline look like an annotation plus the newline." (goto-char (next-overlay-change (point))) (if (>= (point) limit) @@ -1182,8 +1235,8 @@ annotation plus the newline." start-word) (defun annotate-group-by-width (text maximum-width) - "Groups `TEXT' in a list formed by chunks of maximum size equal -to `MAXIMUM-WIDTH'." + "Groups TEXT in a list formed by chunks of maximum size equal +to MAXIMUM-WIDTH." (cl-labels ((next-word (words) (or (cl-first words) "")) @@ -1255,8 +1308,8 @@ to `MAXIMUM-WIDTH'." grouped)))) (cl-defun annotate-safe-subseq (seq from to &optional (value-if-limits-invalid seq)) - "Return a substring of `SEQ' or `VALUE-IF-LIMITS-INVALID' -sequence if `FROM' or `TO' are invalids." + "Return a substring of SEQ or VALUE-IF-LIMITS-INVALID +sequence if FROM or TO are invalids." (cond ((< to from) value-if-limits-invalid) @@ -1268,7 +1321,7 @@ sequence if `FROM' or `TO' are invalids." (cl-subseq seq from to)))) (defun annotate-lineate (text line-width) - "Breaks `TEXT' into lines to fit in the annotation space with width `LINE-WIDTH'." + "Breaks TEXT into lines to fit in the annotation space with width LINE-WIDTH." (cl-labels ((pad (string max-width add-newline-p) (if (null string) "" @@ -1306,12 +1359,12 @@ sequence if `FROM' or `TO' are invalids." (list (pad last-line max-width nil))))))) (cl-defun annotate--split-lines (text &optional (separator "\n")) - "Return `TEXT' splitted by `SEPARATOR' (default: \"\n\")." + "Return TEXT splitted by SEPARATOR (default: \"\n\")." (save-match-data (split-string text separator))) (defun annotate--join-with-string (strings junction) -"Join list of string in `STRINGS' using string `JUNCTION'." + "Join list of string in STRINGS using string JUNCTION." (cl-reduce (lambda (a b) (concat a junction b)) strings)) @@ -1320,12 +1373,12 @@ sequence if `FROM' or `TO' are invalids." end-of-line annotation-on-is-own-line-p) "Pads or breaks annotation text (as property of -`ANNOTATION-OVERLAY' so that all lines have the same width. +ANNOTATION-OVERLAY so that all lines have the same width. If annotation is a placed on the margin of a window (that is -`ANNOTATION-ON-IS-OWN-LINE-P' is +ANNOTATION-ON-IS-OWN-LINE-P is nil) the text is broken (regardless of words) to fit on the side -of the window using `BEGIN-OF-LINE' `END-OF-LINE'. +of the window using BEGIN-OF-LINE END-OF-LINE. If annotation is a note that is placed in its own line the text is padded with spaces so that a \"box\" surround the text without seams, e.g: @@ -1378,150 +1431,153 @@ a a**" (save-excursion ;; (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-first (annotate-make-prefix)) ; white spaces - ; before first - ; line of - ; annotation - (prefix-rest (make-string annotate-annotation-column ? )) - (bol (progn (beginning-of-line) (point))) - (eol (progn (end-of-line) (point))) - (annotation-text "") - (overlays nil) - (overlays-counter 1) - (hidden-text nil)) - ;; include previous line if point is at bol: - (when (null (overlays-in bol eol)) - (setq bol (1- bol))) - (setq overlays - (sort (cl-remove-if-not #'annotationp - (overlays-in bol eol)) - (lambda (x y) - (< (overlay-end x) (overlay-end y))))) - ;; configure each annotation's properties and place it on the - ;; the window. The default position of the annotation (newline - ;; or right margin) is indicated by the value of the - ;; variable: `annotate-annotation-position-policy'. - (dolist (ov overlays) - (let* ((last-ring-p (annotate-chain-last-p ov)) - (annotation-face (annotate-annotation-face ov)) ; added by annotate-create-annotation - (annotation-text-face (annotate-annotation-property-annotation-face ov)) ; added by annotate-create-annotation - (position (annotate-annotation-get-position ov)) - (annotation-long-p (> (string-width (annotate-annotation-get-annotation-text ov)) - annotate-annotation-max-size-not-place-new-line)) - (new-position-policy position)) - (if (null position) - (setf new-position-policy - (if (eq annotate-annotation-position-policy - :by-length) - (if annotation-long-p - :new-line - :margin) - annotate-annotation-position-policy)) + ;; find overlays in the preceding line + (let ((prefix-first (annotate-make-prefix)) ; white spaces + ; before first + ; line of + ; annotation + (prefix-rest (make-string annotate-annotation-column ? )) + (bol (progn (beginning-of-line) (point))) + (eol (progn (end-of-line) (point))) + (annotation-text "") + (overlays nil) + (overlays-counter 1) + (hidden-text nil)) + ;; include previous line if point is at bol: + (when (null (overlays-in bol eol)) + (setq bol (1- bol))) + (setq overlays + (sort (cl-remove-if-not #'annotationp + (overlays-in bol eol)) + (lambda (x y) + (< (overlay-end x) (overlay-end y))))) + ;; configure each annotation's properties and place it on the + ;; the window. The default position of the annotation (newline + ;; or right margin) is indicated by the value of the + ;; variable: `annotate-annotation-position-policy'. + (dolist (ov overlays) + (let* ((last-ring-p (annotate-chain-last-p ov)) + (annotation-face (annotate-annotation-face ov)) ; added by annotate-create-annotation + (annotation-text-face (annotate-annotation-property-annotation-face ov)) ; added by annotate-create-annotation + (position (annotate-annotation-get-position ov)) + (annotation-long-p (> (string-width (annotate-annotation-get-annotation-text ov)) + annotate-annotation-max-size-not-place-new-line)) + (new-position-policy position)) + (if (null position) (setf new-position-policy - (if (eq position + (if (eq annotate-annotation-position-policy :by-length) (if annotation-long-p :new-line :margin) - position))) - (let* ((wrap-in-a-new-line (eq new-position-policy :new-line)) - (multiline-annotation (annotate-wrap-annotation-in-box ov - bol - eol - wrap-in-a-new-line)) - (annotation-stopper (if (not (eq new-position-policy - :margin)) - (if (= overlays-counter - (length overlays)) - "\n" - "") - "\n")) - (tail-hidden-text-p (and last-ring-p - (annotate-tail-overlay-hide-text-p ov)))) - (setf hidden-text tail-hidden-text-p) - (cl-incf overlays-counter) - (annotate-annotation-set-face ov annotation-face) - (annotate-annotation-set-annotation-face ov annotation-text-face) - (when (and (not annotate-use-echo-area) - (not hidden-text) - (annotate-chain-last-p ov)) - (when (and new-position-policy - (not (eq new-position-policy :margin))) - (setf prefix-first " \n")) - (dolist (l multiline-annotation) - (setq annotation-text - (concat annotation-text - prefix-first - (propertize l 'face annotation-text-face) - annotation-stopper)) - ;; white space before for all but the first annotation line - (if (eq new-position-policy - :new-line) - (setq prefix-first (concat prefix-first prefix-rest)) - (setq prefix-first prefix-rest))))))) - (when (not annotate-use-echo-area) - ;; build facespec with the annotation text as display property - (if (string= annotation-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 annotation-text)))))) + annotate-annotation-position-policy)) + (setf new-position-policy + (if (eq position + :by-length) + (if annotation-long-p + :new-line + :margin) + position))) + (let* ((wrap-in-a-new-line (eq new-position-policy :new-line)) + (multiline-annotation (annotate-wrap-annotation-in-box ov + bol + eol + wrap-in-a-new-line)) + (annotation-stopper (if (not (eq new-position-policy + :margin)) + (if (= overlays-counter + (length overlays)) + "\n" + "") + "\n")) + (tail-hidden-text-p (and last-ring-p + (annotate-tail-overlay-hide-text-p ov)))) + (setf hidden-text tail-hidden-text-p) + (cl-incf overlays-counter) + (annotate-annotation-set-face ov annotation-face) + (annotate-annotation-set-annotation-face ov annotation-text-face) + (when (and (not annotate-use-echo-area) + (not hidden-text) + (annotate-chain-last-p ov)) + (when (and new-position-policy + (not (eq new-position-policy :margin))) + (setf prefix-first " \n")) + (dolist (l multiline-annotation) + (setq annotation-text + (concat annotation-text + prefix-first + (propertize l 'face annotation-text-face) + annotation-stopper)) + ;; white space before for all but the first annotation line + (if (eq new-position-policy + :new-line) + (setq prefix-first (concat prefix-first prefix-rest)) + (setq prefix-first prefix-rest))))))) + (when (not annotate-use-echo-area) + ;; build facespec with the annotation text as display property + (if (string= annotation-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 annotation-text)))))) (defun annotate--remove-annotation-property (_begin end) "Cleans up annotation properties associated within a region -surrounded by `BEGIN' and `END'." +surrounded by _BEGIN and END." (when (and annotate-mode (> (buffer-size) 0)) (with-silent-modifications (annotate-with-disable-read-only - ;; copy undo list - (let ((saved-undo-list (copy-tree buffer-undo-list t))) - ;; inhibit property removal to the undo list (and empty it too) - (buffer-disable-undo) - (save-excursion - (goto-char end) - ;; go to the EOL where the - ;; annotated newline used to be - (end-of-line) - ;; strip dangling display property - (when (< (point) - (point-max)) - (remove-text-properties (point) (1+ (point)) '(display nil)))) - ;; restore undo list - (setf buffer-undo-list saved-undo-list) - (buffer-enable-undo)))))) + ;; copy undo list + (let ((saved-undo-list (copy-tree buffer-undo-list t))) + ;; inhibit property removal to the undo list (and empty it too) + (buffer-disable-undo) + (save-excursion + (goto-char end) + ;; go to the EOL where the + ;; annotated newline used to be + (end-of-line) + ;; strip dangling display property + (when (< (point) + (point-max)) + (remove-text-properties (point) (1+ (point)) '(display nil)))) + ;; restore undo list + (setf buffer-undo-list saved-undo-list) + (buffer-enable-undo)))))) (defun annotate-annotations-overlay-in-range (from-position to-position) "Return the annotations overlays that are enclosed in the range -defined by `FROM-POSITION' and `TO-POSITION'." - (let ((annotations ())) - (cl-loop for i - from (max 0 (1- from-position)) - to to-position - do - (let ((annotation (annotate-next-annotation-starts i))) - (annotate-ensure-annotation (annotation) - (let ((chain-end (overlay-end (annotate-chain-last annotation))) - (chain-start (overlay-start (annotate-chain-first annotation)))) - (when (and (>= chain-start from-position) - (<= chain-end to-position)) - (cl-pushnew annotation annotations)))))) +defined by FROM-POSITION and TO-POSITION." + (let ((annotations ()) + (counter (max 0 (1- from-position)))) + (catch 'scan-loop + (while (<= counter + to-position) + (cl-incf counter) + (let ((annotation (annotate-next-annotation-starts counter))) + (if (annotationp annotation) + (let ((chain-end (overlay-end (annotate-chain-last annotation))) + (chain-start (overlay-start (annotate-chain-first annotation)))) + (setf counter chain-end) + (when (and (>= chain-start from-position) + (<= chain-end to-position)) + (cl-pushnew annotation annotations))) + (throw 'scan-loop t))))) (reverse annotations))) (defun annotate-annotations-chain-in-range (from-position to-position) "Return the annotations (chains) that are enclosed in the range -defined by `FROM-POSITION' and `TO-POSITION'." +defined by FROM-POSITION and TO-POSITION." (let ((annotations (annotate-annotations-overlay-in-range from-position to-position)) (chains ())) (cl-loop for annotation in annotations do - (let ((chain (annotate-find-chain annotation))) - (cl-pushnew chain chains :test (lambda (a b) (eq (cl-first a) (cl-first b)))))) + (let ((chain (annotate-find-chain annotation))) + (cl-pushnew chain chains :test (lambda (a b) (eq (cl-first a) (cl-first b)))))) (reverse chains))) (defun annotate--change-guard () - "Return a `facespec` with an `insert-behind-hooks` property -that strips dangling `display` properties of text insertions if + "Return a `facespec' with an `insert-behind-hooks' property +that strips dangling `display' properties of text insertions if text is inserted. This cleans up after newline insertions between an overlay and it's annotation." (list 'face @@ -1530,8 +1586,8 @@ an overlay and it's annotation." '(annotate--remove-annotation-property))) (defun annotate-prefix-lines (prefix text &optional omit-trailing-null) - "Prepend `PREFIX' to each line in `TEXT'. -If `OMIT-TRAILING-NULL' is non null, empty line at the end of + "Prepend PREFIX to each line in TEXT. +If OMIT-TRAILING-NULL is non null, empty line at the end of text will be discarded." (let ((lines (annotate--split-lines text "\n"))) (when omit-trailing-null @@ -1544,16 +1600,16 @@ text will be discarded." ;;; database related procedures (defun annotate-info-actual-filename () - "The info filename that feed this buffer or nil if not this + "The info filename that feed this buffer or nil if not this buffer is not on info-mode" (annotate-guess-filename-for-dump Info-current-file nil)) (cl-defun annotate-indirect-buffer-p (&optional (buffer (current-buffer))) - "Returns non nil if `BUFFER' (default the current buffer) is an indirect buffer." + "Returns non nil if BUFFER (default the current buffer) is an indirect buffer." (buffer-base-buffer buffer)) (defun annotate-indirect-buffer-current-p () -"Returns non nil if the current buffer is an indirect buffer." + "Returns non nil if the current buffer is an indirect buffer." (annotate-indirect-buffer-p)) (defun annotate-actual-file-name () @@ -1569,7 +1625,7 @@ buffer is not on info-mode" (cl-defun annotate-guess-filename-for-dump (filename &optional (return-filename-if-not-found-p t)) - "Guess an acceptable file name suitable for metadata database from `FILENAME'." + "Guess an acceptable file name suitable for metadata database from FILENAME." (cond ((annotate-string-empty-p filename) nil) @@ -1588,7 +1644,7 @@ buffer is not on info-mode" found)))) (defun annotate-make-annotation-dump-entry (filename file-annotations checksum) - "Make an annotation record: see `ANNOTATE-LOAD-ANNOTATIONS'." + "Make an annotation record: see `annotate-load-annotations'." (list filename file-annotations checksum)) @@ -1626,29 +1682,29 @@ file." (cl-first record)) (defun annotate-beginning-of-annotation (annotation) - "Get the starting point of an annotation. The arg \"annotation\" must be a single + "Get the starting point of an annotation. The arg ANNOTATION must be a single annotation field got from a file dump of all annotated buffers, essentially what you get from: \(annotate-annotations-from-dump (nth index (annotate-load-annotations))))." (cl-first annotation)) (defun annotate-ending-of-annotation (annotation) - "Get the ending point of an annotation. The arg \"annotation\" must be a single + "Get the ending point of an annotation. The arg ANNOTATION must be a single annotation field got from a file dump of all annotated buffers, essentially what you get from: \(annotate-annotations-from-dump (nth index (annotate-load-annotations))))." (cl-second annotation)) (defun annotate--interval-left-limit (a) - "Given an annotation record `A' returns the left limit of the annotated text." + "Given an annotation record A returns the left limit of the annotated text." (cl-first a)) (defun annotate--interval-right-limit (a) - "Given an annotation record `A' returns the right limit of the annotated text." + "Given an annotation record A returns the right limit of the annotated text." (cl-second a)) (defun annotate--make-interval (left-limit right-limit) - "Make an interval from `LEFT-LIMIT' and `RIGHT-LIMIT'." + "Make an interval from LEFT-LIMIT and RIGHT-LIMIT." (list left-limit right-limit)) (defun annotate-annotation-interval (annotation) @@ -1657,23 +1713,25 @@ The limit is a list of two numbers (LEFT RIGHT) representing of the portion of the buffer where this annotation is applied. Note that this function returns the character interval yyyyyyyy ggg - ^^^^^^^ ← Annotation interval in the database (extends for one more than the last character) + ^^^^^^^ ← Annotation interval in the database + (extends for one more than the last character) |----| ← The interval that this function returns. -In other terms the interval in the database is a closed interval while the interval that -this function return is closed on the left and open on the right side." +In other terms the interval in the database is a closed interval while +the interval that this function return is closed on the left and open on +the right side." (annotate--make-interval (annotate-beginning-of-annotation annotation) (1- (annotate-ending-of-annotation annotation)))) (defun annotate-annotation-string (annotation) - "Get the text of an annotation. The arg \"annotation\" must be a single + "Get the text of an annotation. The arg ANNOTATION must be a single annotation field got from a file dump of all annotated buffers, essentially what you get from: \(annotate-annotations-from-dump (nth index (annotate-load-annotations))))." (nth 2 annotation)) (defun annotate-annotated-text (annotation) - "Get the annotated text of an annotation. The arg `ANNOTATION' must be a single + "Get the annotated text of an annotation. The arg ANNOTATION must be a single annotation field got from a file dump of all annotated buffers, essentially what you get from: \(annotate-annotations-from-dump (nth index (annotate-load-annotations))))." @@ -1688,8 +1746,8 @@ essentially what you get from: (annotate-save-annotations))))) (cl-defun annotate--dump-indirect-buffer (annotations &optional (indirect-buffer (current-buffer))) -"Clone an annotated indirect buffer into a new buffer. -`ANNOTATIONS' containd the annotations and `INDIRECT-BUFFER' + "Clone an annotated indirect buffer into a new buffer. +ANNOTATIONS containd the annotations and INDIRECT-BUFFER \(default the current buffer) is the buffer to be cloned." (when annotations (let* ((new-buffer-name (generate-new-buffer-name (concat (buffer-name indirect-buffer) @@ -1734,32 +1792,32 @@ essentially what you get from: (all-annotations (annotate-load-annotation-data t)) (filename (annotate-guess-filename-for-dump (annotate-actual-file-name)))) (cond - (filename - (if (assoc-string filename all-annotations) - (setcdr (assoc-string filename all-annotations) - (list file-annotations - (annotate-buffer-checksum))) - (setq all-annotations - (push (annotate-make-annotation-dump-entry filename - file-annotations - (annotate-buffer-checksum)) - all-annotations))) - ;; remove duplicate entries (a user reported seeing them) - (dolist (entry all-annotations) - (delete-dups entry)) - ;; skip files with no annotations - (annotate-dump-annotation-data (cl-remove-if (lambda (entry) - (null (annotate-annotations-from-dump entry))) - all-annotations)) - (when annotate-use-messages - (message "Annotations saved."))) - ((annotate-indirect-buffer-current-p) - (annotate--dump-indirect-buffer file-annotations)) - (file-annotations - (lwarn '(annotate-mode) - :warning - annotate-warn-buffer-has-no-valid-file - (current-buffer)))))) + (filename + (if (assoc-string filename all-annotations) + (setcdr (assoc-string filename all-annotations) + (list file-annotations + (annotate-buffer-checksum))) + (setq all-annotations + (push (annotate-make-annotation-dump-entry filename + file-annotations + (annotate-buffer-checksum)) + all-annotations))) + ;; remove duplicate entries (a user reported seeing them) + (dolist (entry all-annotations) + (delete-dups entry)) + ;; skip files with no annotations + (annotate-dump-annotation-data (cl-remove-if (lambda (entry) + (null (annotate-annotations-from-dump entry))) + all-annotations)) + (when annotate-use-messages + (message "Annotations saved."))) + ((annotate-indirect-buffer-current-p) + (annotate--dump-indirect-buffer file-annotations)) + (file-annotations + (lwarn '(annotate-mode) + :warning + annotate-warn-buffer-has-no-valid-file + (current-buffer)))))) (defun annotate-load-annotation-old-format () "Load all annotations from disk in old format." @@ -1810,14 +1868,15 @@ finally annotation is: \(START END ANNOTATION-STRING ANNOTATED-TEXT COLOR-INDEX) -START: the buffer position where annotated text start -END: the buffer position where annotated text ends -ANNOTATION-STRING: the text of annotation -ANNOTATED-TEXT: the substring of buffer from START to END (as above) -COLOR-INDEX: the index position in `annotate-annotation-text-faces' and - `annotate-highlight-faces' to chode the annotation's visual -POSITIONING-POLICY a keyword representing the startegy for the annotation's text position; - the allowed values are specified in: annotate-allowed-positioning-policy +START: the buffer position where annotated text start +END: the buffer position where annotated text ends +ANNOTATION-STRING: the text of annotation +ANNOTATED-TEXT: the substring of buffer from START to END (as above) +COLOR-INDEX: the index position in `annotate-annotation-text-faces' and + `annotate-highlight-faces' to chode the annotation's visual +POSITIONING-POLICY: a keyword representing the stategy for the annotation's + text position; the allowed values are specified in: + `annotate-allowed-positioning-policy' example: @@ -1846,32 +1905,32 @@ example: ((and (null annotations) annotate-use-messages) (message annotate-message-annotations-not-found)) - (annotations - (save-excursion - (dolist (annotation annotations) - (let* ((start (annotate-beginning-of-annotation annotation)) - (end (annotate-ending-of-annotation annotation)) - (annotation-string (annotate-annotation-string annotation)) - (annotated-text (annotate-annotated-text annotation)) - (dump-color-index (annotate-color-index-from-dump annotation)) - (color-index (if (and dump-color-index - (< dump-color-index - (length annotate-highlight-faces))) - dump-color-index - nil)) - (position (annotate-placement-policy-from-dump annotation))) - (annotate-create-annotation start - end - annotation-string - annotated-text - color-index - position)))))) + (annotations + (save-excursion + (dolist (annotation annotations) + (let* ((start (annotate-beginning-of-annotation annotation)) + (end (annotate-ending-of-annotation annotation)) + (annotation-string (annotate-annotation-string annotation)) + (annotated-text (annotate-annotated-text annotation)) + (dump-color-index (annotate-color-index-from-dump annotation)) + (color-index (if (and dump-color-index + (< dump-color-index + (length annotate-highlight-faces))) + dump-color-index + nil)) + (position (annotate-placement-policy-from-dump annotation))) + (annotate-create-annotation start + end + annotation-string + annotated-text + color-index + position)))))) (font-lock-flush) (when annotate-use-messages (message annotate-message-annotation-loaded)))))) (defun annotate-db-clean-records (records-db) - "Remove records from arg `RECORDS-DB' that have empty annotation, example: + "Remove records from arg RECORDS-DB that have empty annotation, example: \\='((\"/foo/bar.dat\" nil \"abababababababababababababab\") (\"/foo/baz.dat\" ((0 9 \"note\" \"annotated\")) \"abababababababababababababab\")) @@ -1885,14 +1944,14 @@ i.e. the first record is removed." records-db)) (defun annotate-db-purge () - "Update database *on disk* removing all the records with empty + "Update database *on disk* removing all the records with empty annotation." (interactive) (let ((db (annotate-db-clean-records (annotate-load-annotation-data t)))) (annotate-dump-annotation-data db))) (defun annotate--expand-record-path (record) -"Expand file component of `RECORD'." + "Expand file component of RECORD." (let* ((short-filename (annotate-filename-from-dump record)) (annotations (annotate-annotations-from-dump record)) (file-checksum (annotate-checksum-from-dump record)) @@ -1906,7 +1965,7 @@ annotation." file-checksum))) (defun annotate--deserialize-database-file (file) - "Return a sexp from the annotation database contained in `FILE'." + "Return a sexp from the annotation database contained in FILE." (with-temp-buffer (let* ((annotations-file file) (attributes (file-attributes annotations-file))) @@ -1922,12 +1981,12 @@ annotation." (defun annotate-load-annotation-data (&optional ignore-errors) "Read and returns saved annotations." - (if ignore-errors - (ignore-errors (annotate--deserialize-database-file annotate-file)) - (annotate--deserialize-database-file annotate-file))) + (if ignore-errors + (ignore-errors (annotate--deserialize-database-file annotate-file)) + (annotate--deserialize-database-file annotate-file))) (defun annotate-dump-annotation-data (data &optional save-empty-db) - "Save `DATA' into annotation file." + "Save DATA into annotation file." (cond ((or save-empty-db data) @@ -1972,9 +2031,9 @@ annotation." record-filename annotation-beginning annotation-ending) - "Remove from database `DB-RECORDS' the annotation identified by -the triplets `RECORD-FILENAME', `ANNOTATION-BEGINNING' and - `ANNOTATION-ENDING'; if such annotation does exists." + "Remove from database DB-RECORDS the annotation identified by +the triplets RECORD-FILENAME, ANNOTATION-BEGINNING and + ANNOTATION-ENDING; if such annotation does exists." (with-matching-annotation-fns (record-filename annotation-beginning @@ -1990,16 +2049,16 @@ the triplets `RECORD-FILENAME', `ANNOTATION-BEGINNING' and checksum))) (push new-record rest-of-db)) - db-records)))) + db-records)))) (defun annotate-db-replace-annotation (db-records record-filename annotation-beginning annotation-ending replacing-text) - "Replace the text of annotation from database `DB-RECORDS' -identified by the triplets `RECORD-FILENAME', - `ANNOTATION-BEGINNING' and `ANNOTATION-ENDING'; if such + "Replace the text of annotation from database DB-RECORDS +identified by the triplets RECORD-FILENAME, + ANNOTATION-BEGINNING and ANNOTATION-ENDING; if such annotation does exists." (with-matching-annotation-fns (record-filename @@ -2028,7 +2087,7 @@ identified by the triplets `RECORD-FILENAME', db-records)))) (defun annotate-db-annotations-starts-before-p (a b) - "Non nil if annotation `A' starts before `B'. + "Non nil if annotation A starts before B. In this context annotation means annotation loaded from local database not the annotation shown in the buffer (therefore these @@ -2053,13 +2112,13 @@ functions)." (delete-overlay ov)))) (defun annotate-string-empty-p (a) - "Is the arg `A' an empty string or null?" + "Is the arg A an empty string or null?" (or (null a) (string= "" a))) (defun annotate-annotation-prop-get (annotation property) - "Get property `PROPERTY' from annotation `ANNOTATION'. If -`ANNOTATION' does not pass `annotationp' returns nil." + "Get property PROPERTY from annotation ANNOTATION. If +ANNOTATION does not pass `annotationp' returns nil." (annotate-ensure-annotation (annotation) (overlay-get annotation property))) @@ -2074,13 +2133,13 @@ in a chain of annotations." (overlay-put annotation annotate-prop-chain-position pos)) (defun annotate-chain-last-p (annotation) - "Non nil if `ANNOTATION' is the last element of a chain of annotations." + "Non nil if 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 `ANNOTATION' is the first element, or the only + "Non nil if 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)) @@ -2095,7 +2154,7 @@ of a chain of annotations." annotate-prop-chain-pos-marker-last)))))) (defun annotate-chain-first (annotation) - "Find first element of the chain where `ANNOTATION' belongs." + "Find first element of the chain where ANNOTATION belongs." (cond ((null annotation) nil) @@ -2107,7 +2166,7 @@ of a chain of annotations." (annotate-chain-first previous-annotation))))) (defun annotate-chain-last (annotation) - "Find last element of the chain where `ANNOTATION' belongs." + "Find last element of the chain where ANNOTATION belongs." (cond ((null annotation) nil) @@ -2119,19 +2178,19 @@ of a chain of annotations." (annotate-chain-last next-annotation))))) (defun annotate-chain-first-at (pos) - "Find first element of the chain of annotation that overlap point `POS'." + "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'." + "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-chain-at (pos) - "Find the chain of overlays where point `POS' belongs." + "Find the chain of overlays where point POS belongs." (let ((annotation (annotate-annotation-at pos))) (annotate-ensure-annotation (annotation) (annotate-find-chain annotation)))) @@ -2147,7 +2206,7 @@ in a chain of annotations as last." (annotate-annotation-chain-position annotation annotate-prop-chain-pos-marker-last)) (defun annotate-find-chain (annotation) - "Find all ANNOTATION that are parts of the chain where `ANNOTATION' belongs." + "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)))) @@ -2171,45 +2230,45 @@ in a chain of annotations as last." (reverse results)))))) (defun annotate-annotations-chain-at (pos) - "Find all annotation that are parts of the chain that overlaps at `POS'." + "Find all annotation that are parts of the chain that overlaps at POS." (annotate-find-chain (annotate-annotation-at pos))) (defun annotate-chain-hide-text (chain) - "Sets an overlay properties of the last ring of `CHAIN' so that + "Sets an overlay properties of the last ring of CHAIN so that the annotation's text will not be rendered." (let ((last-ring (annotate-chain-last-ring chain))) (overlay-put last-ring 'hide-text t))) (defun annotate-chain-show-text (chain) - "Sets an overlay properties of the last ring of `CHAIN' so that + "Sets an overlay properties of the last ring of CHAIN so that the annotation's text will be rendered." (let ((last-ring (annotate-chain-last-ring chain))) (overlay-put last-ring 'hide-text nil))) (defun annotate-chain-hide-text-p (chain) - "Non nil if the annotation's text contained in the last ring of `CHAIN' + "Non nil if the annotation's text contained in the last ring of CHAIN must not be rendered." (let ((last-ring (annotate-chain-last (cl-first chain)))) (annotate-tail-overlay-hide-text-p last-ring))) (defun annotate-tail-overlay-hide-text-p (overlay) - "Get the property for hiding the annotation text from `OVERLAY'." + "Get the property for hiding the annotation text from OVERLAY." (overlay-get overlay 'hide-text)) (defun annotate-create-annotation (start end annotation-text annotated-text &optional color-index position) - "Create a new annotation for selected region (from `START' to `END'. + "Create a new annotation for selected region (from START to END. -Here the argument `ANNOTATION-TEXT' is the string that appears -on the margin of the window and \"annotated-text\" is the string +Here the argument ANNOTATION-TEXT is the string that appears +on the margin of the window and ANNOTATED-TEXT is the string that is underlined. If this function is called from procedure -\"annotate-load-annotations\" the argument `ANNOTATED-TEXT' +`annotate-load-annotations' the argument ANNOTATED-TEXT should be not null. In this case we know that an annotation existed in a text interval defined in the database metadata (the database located in the file specified by the -variable \"annotate-file\") and should just be +variable `annotate-file') and should just be restored. Sometimes the annotated text (see above) can not be found in said interval because the annotated file's content changed and `annotate-mode' could not track the @@ -2221,11 +2280,13 @@ interval and, if found, the buffer is annotated right there. The searched interval can be customized setting the variable: \"annotate-search-region-lines-delta\". -`COLOR-INDEX`, if non-null (default nil), is used as index to address -elements both in `annotate-color-index-from-dump' -and `annotate-color-index-from-dump' to specify annotation appearance. +COLOR-INDEX, if non-null (default nil), is used as index to address +elements both in ANNOTATE-COLOR-INDEX-FROM-DUMP +and ANNOTATE-COLOR-INDEX-FROM-DUMP to specify annotation appearance. -Finally `POSITION` indicates the positioning policy for the annotation, if null the value bound to `annotate-annotation-position-policy` is used." +Finally POSITION indicates the positioning policy for the annotation, +if null the value bound to ANNOTATE-ANNOTATION-POSITION-POLICY is +used." (cl-labels ((face-annotation-shifting-point (position shifting-direction-function) (when-let* ((annotation (funcall shifting-direction-function position)) @@ -2245,8 +2306,8 @@ Finally `POSITION` indicates the positioning policy for the annotation, if null annotate-highlight-faces)) (create-annotation (start end annotation-text) (if (null color-index) - (when-let ((new-face-index (available-face-index (face-annotation-before-point start) - (face-annotation-after-point end)))) + (when-let* ((new-face-index (available-face-index (face-annotation-before-point start) + (face-annotation-after-point end)))) (setf annotate-colors-index-counter new-face-index)) (cl-incf annotate-colors-index-counter)) @@ -2401,39 +2462,39 @@ Finally `POSITION` indicates the positioning policy for the annotation, if null (font-lock-fontify-block 1)))))) (defun annotate-overlay-put-echo-help (overlay text) - "Set the property `HELP-ECHO' to `TEXT' in overlay `OVERLAY'." + "Set the property `help-echo' to TEXT in overlay OVERLAY." (overlay-put overlay 'help-echo text)) (defun annotate-overlay-get-echo-help (overlay) - "Set the property `HELP-ECHO' from overlay `OVERLAY'." + "Set the property `help-echo' from overlay OVERLAY." (overlay-get overlay 'help-echo)) (defun annotate-overlay-maybe-set-help-echo (overlay annotation-text) - "Set the property `HELP-ECHO' to `TEXT' in overlay `OVERLAY' if + "Set the property `help-echo' to ANNOTATION-TEXT in overlay OVERLAY if the annotations should be shown in a popup fashion. -See the variable: `ANNOTATE-USE-ECHO-AREA'." +See the variable: `annotate-use-echo-area'." (when annotate-use-echo-area (annotate-overlay-put-echo-help overlay annotation-text))) (defun annotate--delete-annotation-chain (annotation) - "Delete `ANNOTATION' from a buffer and the chain it belongs to. + "Delete ANNOTATION from a buffer and the chain it belongs to. This function is not part of the public API." (annotate-ensure-annotation (annotation) - (save-excursion - (with-current-buffer (current-buffer) - (let* ((chain (annotate-find-chain annotation))) - ;; (filename (annotate-actual-file-name)) - (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))))))) + (save-excursion + (with-current-buffer (current-buffer) + (let* ((chain (annotate-find-chain annotation))) + ;; (filename (annotate-actual-file-name)) + (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))))))) (defun annotate--delete-annotation-chain-ring (annotation-ring) - "Delete overlay of `ANNOTATION-RING' from a buffer. + "Delete overlay of ANNOTATION-RING from a buffer. A ring is a single element of an annotation chain. @@ -2448,7 +2509,7 @@ This function is not part of the public API." (defun annotate-delete-chain-element (annotation) "Delete a ring (a ring is a single element of an ANNOTATION chain.) -from a chain where `ANNOTATION' belong." +from a chain where ANNOTATION belong." (annotate-ensure-annotation (annotation) (let* ((chain (annotate-find-chain annotation)) (first-of-chain-p (annotate-chain-first-p annotation)) @@ -2466,7 +2527,7 @@ from a chain where `ANNOTATION' belong." (annotate-annotation-set-chain-last annotation-before)))))))) (defun annotate--cut-left-annotation (annotation) - "Trims `ANNOTATION' exactly one character from the start." + "Trims ANNOTATION exactly one character from the start." (annotate-ensure-annotation (annotation) (let* ((chain (annotate-find-chain annotation)) (first-annotation (annotate-chain-first annotation)) @@ -2484,7 +2545,7 @@ from a chain where `ANNOTATION' belong." (move-overlay first-annotation new-starting-pos first-annotation-ending-pos)))))) (defun annotate--cut-right-annotation (annotation &optional refontify-buffer) - "Trims `ANNOTATION' exactly one character from the end." + "Trims ANNOTATION exactly one character from the end." (annotate-ensure-annotation (annotation) (let* ((chain (annotate-find-chain annotation)) (last-annotation (annotate-chain-last annotation)) @@ -2504,13 +2565,13 @@ from a chain where `ANNOTATION' belong." (move-overlay last-annotation last-annotation-starting-pos new-ending-pos)))))) (defun annotate--delete-annotation-chain-prevent-modification (annotation) -"Delete an annotation chain backing up and restoring modification + "Delete an annotation chain backing up and restoring modification status of the buffer before deletion occured. This function is not part of the public API." (annotate-ensure-annotation (annotation) (with-silent-modifications - (annotate--delete-annotation-chain annotation)))) + (annotate--delete-annotation-chain annotation)))) (defun annotate--confirm-annotation-delete () "Prompt user for delete confirmation. @@ -2519,15 +2580,17 @@ This function is not part of the public API." (y-or-n-p annotate-confirm-deleting-annotation-prompt))) (cl-defun annotate-delete-annotation (&optional (point (point))) - "Command to delete an annotation, `POINT' is the buffer + "Command to delete an annotation, POINT is the buffer position where to look for annotation (default the cursor point)." (interactive) - (when-let ((annotation (annotate-annotation-at point))) + (when-let* ((annotation (annotate-annotation-at point))) (let* ((delete-confirmed-p (annotate--confirm-annotation-delete))) (when delete-confirmed-p (annotate--delete-annotation-chain annotation) - (font-lock-flush))))) + (font-lock-flush))) + (when annotate-autosave + (annotate-save-annotations)))) (defun annotate--confirm-append-newline-at-the-end-of-buffer () "Prompt user for appending newline confirmation. @@ -2535,7 +2598,7 @@ This function is not part of the public API." (y-or-n-p (format annotate-confirm-appending-newline-prompt (buffer-name)))) (defun annotate-change-annotation (pos) - "Change annotation at `POS'. If empty, delete annotation." + "Change annotation at POS. If empty, delete annotation." (let* ((highlight (annotate-annotation-at pos)) (annotation-text (read-from-minibuffer annotate-annotation-prompt (annotate-annotation-get-annotation-text highlight)))) @@ -2570,7 +2633,7 @@ This function is not part of the public API." (defun annotate-annotation-at (pos) "Return the annotations (overlay where (annotationp overlay) -> t) -at positions `POS' or nil if no annotations exists at pos. +at positions POS or nil if no annotations exists at pos. NOTE this assumes that annotations never overlaps so the list of all annotations can contains only one element maximum." @@ -2579,7 +2642,7 @@ all annotations can contains only one element maximum." (cl-first all))) (defun annotate-previous-annotation-ends (pos) - "Return the previous annotation that ends before `POS' or nil if no annotation + "Return the previous annotation that ends before POS or nil if no annotation was found. NOTE this assumes that annotations never overlaps." (cl-labels ((previous-annotation-ends (start) @@ -2596,12 +2659,12 @@ NOTE this assumes that annotations never overlaps." (previous-annotation-ends pos))))) (defun annotate-previous-annotation (annotation) - "Return the annotation before `ANNOTATIONS' or nil if no such + "Return the annotation before ANNOTATIONS or nil if no such annotation exists." - (annotate-previous-annotation-ends (overlay-start (annotate-chain-first annotation)))) + (annotate-previous-annotation-ends (overlay-start (annotate-chain-first annotation)))) (defun annotate-next-annotation-starts (pos) - "Return the next annotation that starts after `POS' or nil if no annotation + "Return the next annotation that starts after POS or nil if no annotation was found. NOTE this assumes that annotations never overlaps." (cl-labels ((next-annotation-ends (start) @@ -2618,13 +2681,13 @@ NOTE this assumes that annotations never overlaps." (next-annotation-ends pos))))) (defun annotate-next-annotation (annotation) - "Return the annotation after `ANNOTATIONS' or nil if no such + "Return the annotation after ANNOTATIONS or nil if no such annotation exists." - (annotate-next-annotation-starts (overlay-end (annotate-chain-last annotation)))) + (annotate-next-annotation-starts (overlay-end (annotate-chain-last annotation)))) (defun annotate-symbol-strictly-at-point () "Return non nil if a symbol is at char immediately following -the point. This is needed as `THING-AT-POINT' family of +the point. This is needed as `thing-at-point' family of functions returns non nil if the thing (a symbol in this case) is around the point, according to the documentation." (cl-labels ((after-point () @@ -2678,9 +2741,9 @@ the point. This is needed as `THING-AT-POINT' family of (right-ends)))) (defun annotate-make-annotation (beginning ending annotation annotated-text) - "Make an annotation record that represent an annotation -starting at `BEGINNING', terminate at `ENDING' with annotation -content `ANNOTATION' and annotated text `ANNOTATED-TEXT'." + "Make an annotation record that represent an annotation +starting at BEGINNING, terminate at ENDING with annotation +content ANNOTATION and annotated text ANNOTATED-TEXT." (list beginning ending annotation annotated-text)) (defun annotate-all-annotations () @@ -2717,12 +2780,12 @@ The format is suitable for database dump." all-annotations)))) (defun annotate-info-root-dir-p (filename) - "Is the name of this file (`FILENAME') equals to the info root node?" + "Is the name of this file (FILENAME) equals to the info root node?" (string= filename annotate-info-root-name)) (defun annotate-guess-file-format (filename) - "Try to guess the file format from `FILENAME'. + "Try to guess the file format from FILENAME. Non nil if the file format is supported from \"annotate\" in a more sophisticated way than plain text." (cl-labels ((file-contents () @@ -2783,6 +2846,15 @@ sophisticated way than plain text." 'follow-link t 'help-echo "Click to replace annotation") +(defun annotate-info-setup (file-or-node buffer) + "Display Info node FILE-OR-NODE in BUFFER. + +Compatibility wrapper for the function `info-setup' and `info-pop-to-buffer'." + (with-no-warnings + (if (version< "30" emacs-version) + (info-pop-to-buffer file-or-node buffer) + (info-setup file-or-node buffer)))) + (defun annotate-summary-show-annotation-button-pressed (button) "Callback called when an annotate-summary-show-annotation-button is activated." (let* ((file (button-get button 'file)) @@ -2790,9 +2862,9 @@ sophisticated way than plain text." (cond ((eq file-type :info) (with-current-buffer-window - "*info*" nil nil - (info-setup file (current-buffer)) - (switch-to-buffer "*info*")) + "*info*" nil nil + (annotate-info-setup file (current-buffer)) + (switch-to-buffer "*info*")) (with-current-buffer "*info*" (goto-char (button-get button 'go-to)))) (t @@ -2801,7 +2873,7 @@ sophisticated way than plain text." (goto-char (button-get button 'go-to)))))))) (defun annotate-update-visited-buffer-maybe (filename) - "Reload annotation mode in the buffer visiting `FILENAME', if such buffer exists." + "Reload annotation mode in the buffer visiting FILENAME, if such buffer exists." (let ((visited-buffer (find-buffer-visiting filename))) (when visited-buffer ;; a buffer is visiting the file (with-current-buffer visited-buffer @@ -2809,7 +2881,7 @@ sophisticated way than plain text." (annotate-mode 1))))) (defun annotate-summary-delete-annotation-button-pressed (button) - "Callback for summary window fired when a \"delete\" button is + "Callback for summary window fired when a \"delete\" button is pressed." (let* ((filename (button-get button 'file)) (beginning (button-get button 'beginning)) @@ -2851,11 +2923,11 @@ pressed." (annotate-show-annotation-summary query nil nil))))) (cl-defun annotate-wrap-text (text &optional (wrapper "\"")) - "Wrap string `TEXT' with string `WRAPPER'." + "Wrap string TEXT with string WRAPPER." (concat wrapper text wrapper)) (cl-defun annotate-unwrap-text (text &optional (wrapper "\"") (left-side t)) - "Remove `WRAPPER' at both ends from `TEXT'." + "Remove WRAPPER at both ends from TEXT." (let ((results text) (wrapper-length (length wrapper))) (when (>= (length text) @@ -2874,9 +2946,9 @@ pressed." results)) (cl-defun annotate-show-annotation-summary (&optional arg-query cut-above-point (save-annotations t)) - "Show a summary of all the annotations in a temp buffer, the + "Show a summary of all the annotations in a temp buffer, the results can be filtered with a simple query language: see -`ANNOTATE-SUMMARY-FILTER-DB'." +`annotate-summary-filter-db'." (interactive) (cl-labels ((ellipsize (text prefix-string) (let* ((prefix-length (string-width prefix-string)) @@ -2951,7 +3023,7 @@ results can be filtered with a simple query language: see snippet))) (build-snippet-info (filename annotation-begin annotation-end) (with-temp-buffer - (info-setup filename (current-buffer)) + (annotate-info-setup filename (current-buffer)) (buffer-substring-no-properties annotation-begin annotation-end))) (build-snippet-from-buffer (filename annotation-begin annotation-end) @@ -3050,7 +3122,7 @@ results can be filtered with a simple query language: see summary window is shown.") (defvar annotate-summary-query-current-token nil - "Holds the next token of the query in `ANNOTATE-SUMMARY-QUERY'.") + "Holds the next token of the query in `annotate-summary-query'.") (defun annotate-summary-query-lexer-symbol (res) "The symbol identifying the token (e.g. \\='and)." @@ -3061,7 +3133,7 @@ summary window is shown.") (elt res 1)) (defun annotate-summary-query-lexer-start (res) - "The starting point of the substring of + "The starting point of the substring of `annotate-summary-query' for this token." (elt res 2)) @@ -3080,7 +3152,7 @@ defined meaning according to our grammar. For example this string: -p.* and (a or not b)' +p.* and (a or not b) will be broken into these tokens: @@ -3104,9 +3176,9 @@ The format is a proper list where: - third and fourth element (currently unused) the substring limits for this token (as returned by - `match-beginning' and `match-end'. + MATCH-BEGINNING and MATCH-END. -Note that spaces are ignored and all the tokens except `re' must +Note that spaces are ignored and all the tokens except \"re\" must not be prefixed with a backslash to match. So, for example not -> will match the token type \\='not but \not will match the token \\='re; this way we can \"protect\" a regexp that contains reserved @@ -3115,7 +3187,7 @@ keyword (aka escaping). The special value :no-more-token is returned after the whole input is processed. -Calling this function with value of LOOK-AHEAD-P nil will `CONSUME' the +Calling this function with value of LOOK-AHEAD-P nil will consume the token from `annotate-summary-query' (i.e. that string is modified). example: @@ -3169,12 +3241,12 @@ example: res))))) (defun annotate-summary-query-parse-end-input-p (token) - "Non nil if there are no more tokens in `ANNOTATE-SUMMARY-QUERY'." + "Non nil if there are no more tokens in `annotate-summary-query'." (eq token :no-more-tokens)) (defun annotate-summary-token-symbol-match (looking-symbol token) - "Return non nil if `LOOKING-SYMBOL' is \"eq\" to the symbol -component of `TOKEN'." + "Return non nil if LOOKING-SYMBOL is \"eq\" to the symbol +component of TOKEN." (eq looking-symbol (annotate-summary-query-lexer-symbol token))) @@ -3205,8 +3277,8 @@ Arguments: - filter-fn is a function that accept two parameters: the regular expression to match (a token of type \\='re, see the lexer - `ANNOTATE-SUMMARY-LEXER' and a single annotation record (see - `ANNOTATE-LOAD-ANNOTATIONS'). + `annotate-summary-lexer' and a single annotation record (see + `annotate-load-annotations`). This function will reject (its value is nil) records that do not match the annotation. @@ -3247,7 +3319,7 @@ Arguments: annotation matchp)))))))) (let* ((look-ahead (annotate-summary-lexer t))) ; the next token that the lexer *will* consume - ; note the second arg is non nil + ; note the second arg is non nil (if (not (annotate-summary-query-parse-end-input-p look-ahead)) (progn (cond @@ -3332,7 +3404,7 @@ Arguments: (operator filter-fn annotation matchp))))) ;; if we are here the lexer can not find any more tokens in the query ;; just return the value of res - res)))) ; end of `(if (not (annotate-summary-query-parse-end-input-p look-ahead))' + res)))) ; end of '(if (not (annotate-summary-query-parse-end-input-p look-ahead))' (defun annotate-summary-query-parse-expression () "Parse rule for expression: @@ -3363,7 +3435,7 @@ NOT := \"not\" DELIMITER := \" ; ASCII 34 (dec) 22 (hex) Note: this function returns the annotation part of the record, see -`ANNOTATE-LOAD-ANNOTATIONS'." +`annotate-load-annotations'." (lambda (annotation query file-filter-fn note-filter-fn) (let ((annotate-summary-query query) ; save the query (query-notes-only nil)) ; the query for just the notes @@ -3379,7 +3451,7 @@ Note: this function returns the annotation part of the record, see (file-mask-raw (annotate-summary-query-lexer-string next-token)) (file-mask (if quoted-file-mask-p (annotate-unwrap-text file-mask-raw "\"") - file-mask-raw)) + file-mask-raw)) (filtered-annotation (funcall file-filter-fn file-mask annotation)) ;; get the operator as in rule (operator-token (annotate-summary-lexer))) @@ -3454,7 +3526,7 @@ Note: this function returns the annotation part of the record, see (defun annotate-summary-filter-db (annotations-dump query remove-annotations-cutoff-point) "Filter an annotation database with a query. -The argument `QUERY' is a string that respect a simple syntax: +The argument QUERY is a string that respect a simple syntax: - [file-mask] [(and | or) [not] regex-note [(and | or) [not] regexp-note ...]] @@ -3535,7 +3607,7 @@ The annotations in each record are sorted by starting point in ascending order." ;;;; misc commands (defun annotate-summary-of-file-from-current-pos () - "Shows a summary window that contains only the annotations in + "Shows a summary window that contains only the annotations in the current buffer and that starts after the current cursor's position." (interactive) @@ -3557,15 +3629,15 @@ annotate minor mode active." (cl-remove-if-not #'annotate-mode-p all-buffers)))) (cl-defun annotate-switch-db (&optional (force-load nil) (database-file-path nil)) - "Ask the user for a new annotation database files, load it and + "Ask the user for a new annotation database files, load it and refresh all the annotations contained in each buffer where annotate minor mode is active. -if `DATABASE-FILE-PATH' is nil (the default) a prompt asking for +if DATABASE-FILE-PATH is nil (the default) a prompt asking for a file containing database is presented to the user, otherwise the value of this argument is used. -If `FORCE-LOAD' is non nil no prompt asking user for confirmation +If FORCE-LOAD is non nil no prompt asking user for confirmation about loading the new file is shown. Note: this function will attempt to load (compile and @@ -3596,9 +3668,9 @@ code, always use load files from trusted sources!" ;;; merging database (defun annotate--merge-interval (a b) -"Merge two annotation interval `A' and `B'. + "Merge two annotation interval A and B. -The new interval is expanded so that includes `A' and `B'." +The new interval is expanded so that includes A and B." (let ((new-left-limit (min (annotate--interval-left-limit a) (annotate--interval-left-limit b))) (new-right-limit (max (annotate--interval-right-limit a) @@ -3607,7 +3679,7 @@ The new interval is expanded so that includes `A' and `B'." new-right-limit))) (defun annotate--db-annotations-overlaps-p (annotation-a annotation-b) - "Return non nil if `ANNOTATION-A' and `ANNOTATION-B' overlaps." + "Return non nil if ANNOTATION-A and ANNOTATION-B overlaps." (let ((interval-a (annotate-annotation-interval annotation-a)) (interval-b (annotate-annotation-interval annotation-b))) (not (or (< (annotate--interval-right-limit interval-b) @@ -3632,8 +3704,8 @@ Uses `annotate--merge-interval'." (annotate-make-annotation left right new-annotation-text new-annotated-text)))) (defun annotate--db-remove-overlap-annotations (annotations &optional accum) -"Recursively merges overlapping annotations in `ANNOTATIONS' -using `ANNOTATE--DB-MERGE-ANNOTATIONS'." + "Recursively merges overlapping annotations in ANNOTATIONS +using `annotate--db-merge-annotations'." (if (= (length annotations) 1) (push (cl-first annotations) accum) (let* ((probe (cl-first annotations)) @@ -3654,7 +3726,7 @@ using `ANNOTATE--DB-MERGE-ANNOTATIONS'." (annotate--db-remove-overlap-annotations rest-annotations (push probe accum)))))) (defun annotate--db-merge-databases (db-1 db-2 &optional accum) -"Recursively merge database `DB-1' and `DB-2'." + "Recursively merge database DB-1 and DB-2." (cl-labels ((find-same-file-record (record annotations-db) (let ((record-filename (annotate-filename-from-dump record))) (cl-find-if (lambda (a) @@ -3687,29 +3759,29 @@ using `ANNOTATE--DB-MERGE-ANNOTATIONS'." (push first-record accum))))))) (defun annotate-import-annotations () -"Prompt user for an annotation database file and merge it into + "Prompt user for an annotation database file and merge it into their personal database." (interactive) (cl-flet ((deserialize-db (file) - (ignore-errors (annotate--deserialize-database-file file))) + (ignore-errors (annotate--deserialize-database-file file))) (remove-non-existing-files (annotations) - (cl-remove-if-not (lambda (a) - (let ((filename (annotate-filename-from-dump a))) - (file-exists-p filename))) - annotations))) - (let* ((confirm-message (concat "Importing databases from untrusted source may cause severe " - "security issues, continue?")) - (import-confirmed-p (or (not annotate-database-confirm-import) - (y-or-n-p confirm-message)))) - (when import-confirmed-p - (let* ((imported-db-name (read-file-name "Choose the database to import: ")) - (imported-db (remove-non-existing-files (deserialize-db imported-db-name))) - (hosting-db (deserialize-db annotate-file)) - (merged-db (annotate--db-merge-databases hosting-db imported-db))) - (annotate-dump-annotation-data merged-db) - (annotate-switch-db t annotate-file) - (when annotate-use-messages - (message "Imported annotations from %s." imported-db-name))))))) + (cl-remove-if-not (lambda (a) + (let ((filename (annotate-filename-from-dump a))) + (file-exists-p filename))) + annotations))) + (let* ((confirm-message (concat "Importing databases from untrusted source may cause severe " + "security issues, continue?")) + (import-confirmed-p (or (not annotate-database-confirm-import) + (y-or-n-p confirm-message)))) + (when import-confirmed-p + (let* ((imported-db-name (read-file-name "Choose the database to import: ")) + (imported-db (remove-non-existing-files (deserialize-db imported-db-name))) + (hosting-db (deserialize-db annotate-file)) + (merged-db (annotate--db-merge-databases hosting-db imported-db))) + (annotate-dump-annotation-data merged-db) + (annotate-switch-db t annotate-file) + (when annotate-use-messages + (message "Imported annotations from %s." imported-db-name))))))) ;;; end of merging datatase -- 2.47.3