├── .gitignore ├── Emacs_CriticMarkup.png ├── CriticMarkup-test.text ├── README.md └── cm-mode.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | -------------------------------------------------------------------------------- /Emacs_CriticMarkup.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/joostkremers/criticmarkup-emacs/HEAD/Emacs_CriticMarkup.png -------------------------------------------------------------------------------- /CriticMarkup-test.text: -------------------------------------------------------------------------------- 1 | # CriticMarkup for Emacs # 2 | 3 | `cm-mode` is a minor mode that provides support for [CriticMarkup](http://criticmarkup.com/) in Emacs. 4 | 5 | CriticMarkup is a way for authors and editors to track changes to documents in plain text. It defines the following {~~patterns~>tags~~} for marking changes: 6 | 7 | - Addition {++ ++} 8 | - Deletion {-- --} 9 | - Substitution {~~ ~> ~~} 10 | - Comment {>> <<} 11 | - Highlight {== ==}{>> <<} 12 | 13 | Activating `cm-mode` provides key{--s--} {++bindings ++}to insert these {~~patterns~>markup tags~~} and thus mark one's changes to the text. The provided {==key bindings==}{>>@jk Should I mention that these are nicely mnemonic?<<} are: 14 | 15 | - `C-c * a`: add text 16 | - `C-c * d`: delete text 17 | - `C-c * s`: substitute text 18 | - `C-c * c`: insert a comment (possibly with highlight) 19 | 20 | The commands to delete or substitute text operate on the region. The command to insert a comment can be used with an active region, in which case the text in the region will be highlighted. It can also be used inside an existing markup to add a comment to it. If it is used anywhere else, it just adds a lone comment. The commands for inserting and substituting text and for inserting a comment {++all ++}put {~~the cursor~>point~~}{>>cursor??!<<} at the correct position, so you can start typing right away. 21 | 22 | Note: the [CriticMarkup spec](http://criticmarkup.com/spec.php) says you should avoid putting newlines in CriticMarkup tags and you should always wrap Markdown tags completely. These are wise precautions for `cm-mode` as well. 23 | 24 | 25 | ## Follow changes mode ## 26 | 27 | `cm-mode` also provides a simple {~~*follow changes*~>'follow changes'~~} mode. When activated, changes you make to the buffer are automatically marked as insertions or deletions. Substitutions cannot be made automatically (that is, if you mark a word, delete it and then type a replacement, it will still be marked as a sequence of deletion+insertion, not as a substitution), but they can still be made manually with `C-c * s`. You can activate and deactivate follow changes mode with `C-c * F`. When it's active, the modeline indicator for `cm-mode` changes from {--`cm`--}{++`CM`++} to {~~`cm*`~>`CM*`~~}. 28 | 29 | 30 | ## Keeping track of the author ## 31 | 32 | Comments can be used to keep track of who made a particular change. If you want to do this automatically, you can set the variable `cm-author` to an identifier. When this variable is set, its value is automatically added as a comment to every change you make, preceded by `@`. If you explicitly make a comment with `C-c * c`, the value of `cm-author` is inserted at the beginning of the comment. 33 | 34 | The variable `cm-author` can be set globally through Customize (or with `setq-default` in your init file). This sets the global value. You can override this global value in a particular buffer by setting a buffer-local value. There are two ways to do this: you can use `C-c * t`, which will only set the value for the current session, or you can use a file-local (or directory-local) variable, which makes sure the value is set every time the file is loaded. (Note: if you use [Pandoc](http://johnmacfarlane.net/pandoc/), you can specify file-local variables with html comments, since Pandoc ignores html comments for all output format.) 35 | 36 | 37 | ## Navigating changes ## 38 | 39 | You can jump to the previous/next change with the commands `C-c * b` and `C-c * f`, respectively. If point is inside a change, you can jump out of it with `C-c * *`. 40 | 41 | 42 | ## Accepting or rejecting changes ## 43 | 44 | You can interactively accept or reject a change by putting the cursor inside it and hitting `C-c * i`. For additions, deletions and substitutions, you get a choice between `a` to accept the change or `r` to reject it. There are two other choices, `s` to skip this change or `q` to quit. Both leave the change untouched and if you're just dealing with the change at point, they are essentially identical. {>>They have different functions when accepting or rejecting all changes interactively, though.<<} 45 | 46 | For comments and highlights, the choices are different: `d` to delete the comment or highlight (whereby the latter of course retains the {~~commented~>highlighted~~} text, but the comment and the markup are removed), or `k` to keep the comment or highlight. Again `q` quits and is essentially identical to `k`. (Note that you can also use `s` instead of `k`, in case you get used to skipping changes that way.) 47 | 48 | You can {++interactively ++}{>>@jk<<}accept or reject{-- interactively--}{>>@jk<<} all changes with `C-c * I` (that is a capital `i`). This will go through each change asking you whether you want to accept, reject or skip it, or delete or keep it. Typing `q` quits the accept/reject session. 49 | 50 | 51 | 52 | ## Font lock ## 53 | 54 | `cm-mode` also adds the markup patterns defined by CriticMarkup to `font-lock-keywords` and provides customisable faces to highlight them. The customisation group is called `criticmarkup`. 55 | 56 | You may notice that changes that span multiple lines are not highlighted. The reason for this is that multiline font lock in Emacs is not straightforward. There are ways to deal with this, but since `cm-mode` is a minor mode, it could interfere with the major mode's font locking mechanism if it did that. 57 | 58 | To mitigate this problem, you can use soft wrap (with `visual-line-mode`). Since each paragraph is then essentially a single line, font lock works even across multiple (visual) lines. 59 | 60 | 61 | ## Disclaimer ## 62 | 63 | `cm-mode` should be considered alpha software, so try at your own risk. If you run into problems, I would very much appreciate it if you open an issue on Github or send me an email. 64 | 65 | 66 | ## TODO ## 67 | 68 | - Commands to accept or reject all changes in one go. {>>These won't be bound to keys, though.<<} 69 | - Do not combine two adjacent additions/deletions if the auto-comment is different. 70 | - Mouse support? 71 | 72 | 73 | ## Sceenshot ## 74 | 75 | ![Emacs CriticMarkup](Emacs_CriticMarkup.png) 76 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CriticMarkup for Emacs # 2 | 3 | `cm-mode` is a minor mode that provides support for [CriticMarkup](http://criticmarkup.com/) in Emacs. 4 | 5 | CriticMarkup is a way for authors and editors to track changes to documents in plain text. It defines the following tags for marking changes: 6 | 7 | - Addition {++ ++} 8 | - Deletion {-- --} 9 | - Substitution {~~ ~> ~~} 10 | - Comment {>> <<} 11 | - Highlight {== ==}{>> <<} 12 | 13 | Activating `cm-mode` provides key bindings to insert these markup tags and thus mark one's changes to the text. The provided key bindings are: 14 | 15 | - `C-c * a`: add text 16 | - `C-c * d`: delete text 17 | - `C-c * s`: substitute text 18 | - `C-c * c`: insert a comment (possibly with highlight) 19 | 20 | The commands to delete or substitute text operate on the region. The command to insert a comment can be used with an active region, in which case the text in the region will be highlighted. It can also be used inside an existing markup to add a comment to it. If it is used anywhere else, it just adds a lone comment. The commands for inserting and substituting text and for inserting a comment all put point at the correct position, so you can start typing right away. 21 | 22 | The commands for adding and deleting text combine additions/deletions that are adjacent: if you make a new addition next to an existing one, the cursor is simply moved into the addition tag. Similarly, if you delete text adjacent to an existing deletion, the deleted text is moved into the tag. 23 | 24 | Note: the [CriticMarkup spec](http://criticmarkup.com/spec.php) says you should avoid putting newlines in CriticMarkup tags and you should always wrap Markdown tags completely. These are wise precautions for `cm-mode` as well. 25 | 26 | 27 | ## Font lock ## 28 | 29 | `cm-mode` also adds the markup tags defined by CriticMarkup to `font-lock-keywords` and provides customisable faces to highlight them. The customisation group is called `criticmarkup-faces`. Note that `cm-mode` also makes the markup tags read-only so that you cannot inadvertently modify them. (Though you can disable the read-only property by setting `cm-read-only-annotations` to `nil`.) 30 | 31 | You may notice that changes that span multiple lines are not highlighted. The reason for this is that multiline font lock in Emacs is not straightforward. There are ways to deal with this, but since `cm-mode` is a minor mode, it could interfere with the major mode's font locking mechanism if it did that. Besides, one is advised not to include newlines inside CriticMarkup tags anyway. 32 | 33 | To mitigate this problem, you can use soft wrap (with `visual-line-mode`). Since each paragraph is then essentially a single line, font lock works even across multiple (visual) lines. 34 | 35 | 36 | ## Keeping track of the author ## 37 | 38 | Comments can be used to keep track of who made a particular change. If you want to do this automatically, you can set the variable `cm-author`. When this variable is set, its value is automatically added as a comment to every change you make, preceded by `@`. If you explicitly make a comment with `C-c * c`, the value of `cm-author` is inserted at the beginning of the comment. 39 | 40 | The variable `cm-author` can be set through Customize or with `setq-default` in your init file. This sets the global value. You can override this global value in a particular buffer by setting a buffer-local value. There are two ways to do this: you can use `C-c * t` (for *tag*), which will only set the value for the current session, or you can use a file-local (or directory-local) variable, which makes sure the value is set every time the file is loaded. (Note: if you use [Pandoc](http://johnmacfarlane.net/pandoc/), you can specify file-local variables with html comments, since Pandoc ignores html comments for all output formats.) 41 | 42 | If `cm-author` is set, a new addition or deletion that is adjacent to an existing one is not combined with it if it has a different author tag. This way you can add changes to a text that already has changes from another author and still keep track of who did what. This *only* works for changes that have a comment with an author tag, however. If the existing addition/deletion does not have an author tag, any addition/deletion made adjacent to it is simply combined with it. 43 | 44 | Note that the modeline shows the buffer's author tag: if `cm-author` is set, the modeline indicator for `cm-mode` takes the form `CM@`. 45 | 46 | 47 | ## Navigating changes ## 48 | 49 | If point is inside a change, you can jump out of it with `C-c * *`. Point will be placed after the closing delimiter. If you are in a change that has a comment, point will be placed after the comment. 50 | 51 | You can jump to the previous/next change with the commands `C-c * b` and `C-c * f`, respectively. These work from anywhere in the buffer, not just when point is inside a change. If `repeat-mode` is enabled, these commands are repeatable with `f` and `b`, respectively. 52 | 53 | 54 | ## Accepting or rejecting changes ## 55 | 56 | You can interactively accept or reject a change by putting the cursor inside it and hitting `C-c * i`. For additions, deletions and substitutions, you get a choice between `a` to accept the change or `r` to reject it, or `s` to skip this change, which leaves the change untouched. 57 | 58 | For comments and highlights, the choices are different: `d` to delete the comment or highlight (the text of the highlight is retained, of course), or `s` to skip the comment or highlight. 59 | 60 | You can interactively accept or reject all changes with `C-c * I` (that is a capital `i`). This will go through each change asking you what you want to do with it. Here, `s` skips the current change and moves on to the next one. In addition, you can type `q`, which leaves the current change alone and quits the accept/reject session. 61 | 62 | 63 | ## Key bindings ## 64 | 65 | By default, `cm-mode` uses `C-c *` as a prefix to all the commands it defines. If this is inconvenient, you can easily change it: 66 | 67 | ``` 68 | (define-key cm-mode-map (kbd "C-c *") nil) 69 | (define-key cm-mode-map (kbd "C-c c") cm-prefix-map) 70 | ``` 71 | 72 | ## Follow changes mode ## 73 | 74 | `cm-mode` also provides a simple 'follow changes' mode. When activated, changes you make to the buffer are automatically marked as insertions or deletions. Substitutions cannot be made automatically (even with `delete-selection-mode`, if you mark a word and then overwrite it, it will still be marked as a sequence of deletion+insertion, not as a substitution), but they can still be made manually with `C-c * s`. 75 | 76 | You can activate and deactivate follow changes mode with `C-c * F`. When it's active, the modeline indicator for `cm-mode` changes from `CM` to `CM*`. Note that some changes are not (properly) recorded, so to what extent this mode is useful very much depends on your needs. 77 | 78 | 79 | ## TODO ## 80 | 81 | - Commands to accept or reject all changes in one go. (These won't be bound to keys, though.) 82 | - Automatic generation of time/date stamp in comments. 83 | - Accept/reject changes of one particular author, skipping the others. 84 | 85 | ## Sceenshot ## 86 | 87 | ![Emacs CriticMarkup](Emacs_CriticMarkup.png) 88 | 89 | -------------------------------------------------------------------------------- /cm-mode.el: -------------------------------------------------------------------------------- 1 | ;;; cm-mode.el --- Minor mode for CriticMarkup 2 | 3 | ;; Copyright (c) 2013-2024 Joost Kremers 4 | 5 | ;; Author: Joost Kremers 6 | ;; Maintainer: Joost Kremers 7 | ;; Created: 14 Feb 2013 8 | ;; Version: 1.9 9 | ;; Keywords: text, markdown 10 | ;; Package-Requires: ((emacs "25.1") (cl-lib "0.5")) 11 | 12 | ;; Redistribution and use in source and binary forms, with or without 13 | ;; modification, are permitted provided that the following conditions 14 | ;; are met: 15 | ;; 16 | ;; 1. Redistributions of source code must retain the above copyright 17 | ;; notice, this list of conditions and the following disclaimer. 18 | ;; 2. Redistributions in binary form must reproduce the above copyright 19 | ;; notice, this list of conditions and the following disclaimer in the 20 | ;; documentation and/or other materials provided with the distribution. 21 | ;; 3. The name of the author may not be used to endorse or promote products 22 | ;; derived from this software without specific prior written permission. 23 | ;; 24 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 25 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 26 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 27 | ;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 28 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 29 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; LOSS OF USE, 30 | ;; DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 31 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 32 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 33 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 34 | 35 | ;;; Commentary: 36 | 37 | ;; CriticMarkup for Emacs 38 | ;; ====================== 39 | ;; 40 | ;; `cm-mode' is a minor mode that provides support for CriticMarkup in Emacs. 41 | ;; 42 | ;; CriticMarkup is a way for authors and editors to track changes to 43 | ;; documents in plain text. It defines the following patterns for marking 44 | ;; changes: 45 | ;; 46 | ;; - Addition {++ ++} 47 | ;; - Deletion {-- --} 48 | ;; - Substitution {~~ ~> ~~} 49 | ;; - Comment {>> <<} 50 | ;; - Highlight {== ==}{>> <<} 51 | ;; 52 | ;; `cm-mode' provides the following functionality: 53 | ;; 54 | ;; - font lock support 55 | ;; - key bindings to insert CriticMarkup. 56 | ;; - 'follow changes' mode: automatically record changes to the buffer. 57 | ;; - accept/reject changes interactively. 58 | ;; - automatically add author tag. 59 | ;; - navigation to move between changes. 60 | ;; 61 | ;; 62 | ;; Key bindings 63 | ;; ------------ 64 | ;; 65 | ;; `cm-mode' provides the following key bindings: 66 | ;; 67 | ;; `C-c * a' : add text 68 | ;; `C-c * d' : delete text 69 | ;; `C-c * s' : make a substitution 70 | ;; `C-c * c' : add a comment 71 | ;; `C-c * i' : accept/reject change at point 72 | ;; `C-c * I' : accept/reject all changes interactively 73 | ;; `C-c * *' : move forward out of a change 74 | ;; `C-c * f' : move forward to the next change 75 | ;; `C-c * b' : move backward to the previous change 76 | ;; `C-c * t' : set author 77 | ;; `C-c * F' : activate follow changes mode 78 | ;; 79 | ;; The `C-c *' prefix can easily be changed, if so desired: 80 | ;; 81 | ;; (define-key cm-mode-map (kbd "C-c *") nil) 82 | ;; (define-key cm-mode-map (kbd "C-c c") 'cm-prefix-map) 83 | ;; 84 | ;; This unbinds `C-c *' and sets up `C-c c' as the prefix for all cm-mode 85 | ;; commands. 86 | ;; 87 | ;; Usage 88 | ;; ----- 89 | ;; 90 | ;; See README.md for details. 91 | 92 | ;;; Code: 93 | 94 | (require 'thingatpt) 95 | (require 'cl-lib) 96 | 97 | (defvar cm-addition-regexp "\\(?:{\\+\\+\\(\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?\\)\\+\\+}\\)" 98 | "CriticMarkup addition regexp.") 99 | 100 | (defvar cm-deletion-regexp "\\(?:{--\\(\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?\\)--}\\)" 101 | "CriticMarkup deletion regexp.") 102 | 103 | (defvar cm-substitution-regexp "\\(?:{~~\\(\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?\\)~>\\(\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?\\)~~}\\)" 104 | "CriticMarkup substitution regexp.") 105 | 106 | (defvar cm-comment-regexp "\\(?:{>>\\(\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?\\)<<}\\)" 107 | "CriticMarkup comment regexp.") 108 | 109 | (defvar cm-highlight-regexp "\\(?:{==\\(\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?\\)==}\\)" 110 | "CriticMarkup highlight regexp.") 111 | 112 | (defvar cm-current-markup-overlay nil 113 | "Overlay marking the current highlight.") 114 | (make-variable-buffer-local 'cm-current-markup-overlay) 115 | 116 | (defgroup criticmarkup nil "Minor mode for CriticMarkup." 117 | :prefix "cm-" 118 | :group 'wp 119 | :group 'markdown) 120 | 121 | (defgroup criticmarkup-faces nil "Faces for CriticMarkup." 122 | :prefix "cm-" 123 | :group 'criticmarkup) 124 | 125 | (defcustom cm-author nil 126 | "Author tag. 127 | If set, each change is automatically marked with a comment 128 | containing this tag. 129 | 130 | The tag should not contain spaces. Do not include the `@' sign, 131 | it is added automatically." 132 | :group 'criticmarkup 133 | :safe 'stringp 134 | :type '(choice (const :tag "None" nil) 135 | (string :tag "Author"))) 136 | (make-variable-buffer-local 'cm-author) 137 | 138 | (defcustom cm-read-only-annotations t 139 | "Make annotations read-only. 140 | By default, annotation markers are read-only, so they cannot be 141 | overwritten. This interferes with reformatting, however, so you 142 | can disable this behaviour. Note that if you change the value of 143 | this variable for a particular buffer, you may need to deactivate 144 | and reactivate `cm-mode'." 145 | :group 'criticmarkup 146 | :safe 'booleanp 147 | :type 'boolean) 148 | (make-variable-buffer-local 'cm-read-only-annotations) 149 | 150 | (defface cm-addition-face '((t (:inherit success))) 151 | "Face for CriticMarkup additions." 152 | :group 'criticmarkup-faces) 153 | 154 | (defface cm-deletion-face '((t (:inherit error))) 155 | "Face for CriticMarkup deletions." 156 | :group 'criticmarkup-faces) 157 | 158 | (defface cm-substitution-face '((t (:inherit font-lock-warning-face))) 159 | "Face for CriticMarkup substitutions." 160 | :group 'criticmarkup-faces) 161 | 162 | (defface cm-comment-face '((t (:inherit font-lock-comment-face))) 163 | "Face for CriticMarkup comments." 164 | :group 'criticmarkup-faces) 165 | 166 | (defface cm-highlight-face '((t (:inherit highlight))) 167 | "Face for CriticMarkup highlights." 168 | :group 'criticmarkup-faces) 169 | 170 | (defvar cm-addition-face 'cm-addition-face 171 | "CriticMarkup addition face.") 172 | 173 | (defvar cm-deletion-face 'cm-deletion-face 174 | "CriticMarkup deletion face.") 175 | 176 | (defvar cm-substitution-face 'cm-substitution-face 177 | "CriticMarkup substitution face.") 178 | 179 | (defvar cm-comment-face 'cm-comment-face 180 | "CriticMarkup comment face.") 181 | 182 | (defvar cm-highlight-face 'cm-highlight-face 183 | "CriticMarkup highlight face.") 184 | 185 | ;;; Create markup predicates. 186 | 187 | (eval-and-compile 188 | (defvar cm-delimiters '((cm-addition "{++" "++}") 189 | (cm-deletion "{--" "--}") 190 | (cm-substitution "{~~" "~>" "~~}") 191 | (cm-comment "{>>" "<<}") 192 | (cm-highlight "{==" "==}")) 193 | "CriticMarkup delimiters.")) 194 | 195 | (eval-and-compile 196 | (mapc (lambda (markup) 197 | (fset (intern (concat (symbol-name markup) "-p")) 198 | `(lambda (change) 199 | (eq (car change) (quote ,markup))))) 200 | (mapcar #'car cm-delimiters))) 201 | 202 | ;;; Font lock 203 | 204 | (defun cm-font-lock-for-markup (type) 205 | "Create a font lock entry for markup TYPE." 206 | (let ((markup (cdr type)) 207 | (face (intern (concat (symbol-name (car type)) "-face"))) 208 | font-lock) 209 | (add-to-list 'font-lock (mapconcat #'(lambda (elt) ; First we create the regexp to match. 210 | (regexp-opt (list elt) t)) 211 | markup 212 | "\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?")) 213 | (add-to-list 'font-lock `(0 ,face prepend) t) ; The highlighter for the entire change. 214 | (dotimes (n (length markup)) 215 | (when cm-read-only-annotations 216 | (add-to-list 'font-lock `(,(1+ n) '(face ,face read-only t)) t) ; Make the tags read-only. 217 | (add-to-list 'font-lock `("." (progn ; And make the read-only property of the final character rear-nonsticky 218 | (goto-char (1- (match-end ,(1+ n)))) 219 | (1+ (point))) 220 | nil 221 | (0 '(face ,face rear-nonsticky (read-only)))) 222 | t))) 223 | font-lock)) 224 | 225 | ;; `cm-font-lock-for-markup' produces a font-lock entry that can be given 226 | ;; to `font-lock-add-keywords'. To illustrate, the entry it produces for 227 | ;; additions is the following: 228 | ;; ("\\({\\+\\+\\)\\(?:[[:ascii:]]\\|[[:nonascii:]]\\)*?\\(\\+\\+}\\)" 229 | ;; (0 cm-addition-face prepend) 230 | ;; (1 '(face cm-addition-face read-only t)) 231 | ;; ("." (progn (goto-char (1- (match-end 1))) 232 | ;; (1+ (point))) 233 | ;; nil 234 | ;; (0 '(face cm-addition-face rear-nonsticky (read-only)))) 235 | ;; (2 '(face cm-addition-face read-only t)) 236 | ;; ("." (progn (goto-char (1- (match-end 2))) 237 | ;; (1+ (point))) 238 | ;; nil 239 | ;; (0 '(face cm-addition-face rear-nonsticky (read-only))))) 240 | ;; 241 | ;; This does some nice magic: it highlights addition markups with 242 | ;; cm-addition-face, it makes the tags themselves, `{++' and `++}', read-only, and 243 | ;; it gives the last character of the tags the text property (rear-nonsticky 244 | ;; (read-only)), so that it's possible to add characters after the tag. 245 | 246 | (defun cm-font-lock-keywords () 247 | "Return a list of font lock keywords." 248 | (mapcar #'cm-font-lock-for-markup cm-delimiters)) 249 | 250 | ;;; Utility functions 251 | 252 | (defmacro cm-without-following-changes (&rest body) 253 | "Execute BODY without following changes." 254 | (declare (indent defun)) 255 | `(let ((inhibit-modification-hooks t)) 256 | ,@body)) 257 | 258 | (defun cm-make-markups-writable () 259 | "Make all CM markup delimiters in the current buffer writable." 260 | (save-excursion 261 | (goto-char (point-min)) 262 | (let ((delims-regexp (concat (regexp-opt (mapcar #'cl-second cm-delimiters) t) 263 | "\\([[:ascii:]]\\|[[:nonascii:]]\\)*?" 264 | "\\(?:\\(~>\\)\\([[:ascii:]]\\|[[:nonascii:]]\\)*?\\)?" 265 | (regexp-opt (mapcar (lambda (e) (car (last e))) cm-delimiters) t))) 266 | (inhibit-read-only t)) 267 | (while (re-search-forward delims-regexp nil t) 268 | (dolist (n '(1 2 3)) 269 | (when (match-string n) 270 | (remove-text-properties (match-beginning n) (match-end n) '(read-only nil rear-nonsticky nil)))))))) 271 | 272 | (defun cm-insert-markup (type &optional text) 273 | "Insert CriticMarkup of TYPE. 274 | Also insert TEXT if non-nil. For deletions, TEXT is the deleted 275 | text; for substitutions, the text to be substituted; for 276 | comments, the text to be highlighted. 277 | 278 | If `cm-author' is set, a comment is added with its value, 279 | preceded with `@'. 280 | 281 | If TYPE is `cm-highlight', a comment is added, which optionally 282 | starts with `cm-author'." 283 | (let* ((delims (cdr (assq type cm-delimiters))) 284 | (bdelim (cl-first delims)) 285 | (middle (if (cl-third delims) (cl-second delims))) ; "~>" for cm-substitution, otherwise nil 286 | (edelim (car (last delims)))) 287 | (insert (or bdelim "") 288 | (or text (if (and (eq type 'cm-comment) 289 | cm-author) 290 | (concat "@" cm-author " ") 291 | "")) 292 | (or middle "") 293 | (or edelim ""))) 294 | (if (and (not (eq type 'cm-comment)) 295 | (or cm-author (eq type 'cm-highlight))) 296 | (insert "{>>" 297 | (if cm-author (concat "@" cm-author)) 298 | (if (and (eq type 'cm-highlight) 299 | cm-author) 300 | " " 301 | "") 302 | "<<}"))) 303 | 304 | ;;; User functions 305 | 306 | (defvar cm-mode-map 307 | (let ((map (make-sparse-keymap))) 308 | (define-key map (kbd "C-c *") 'cm-prefix-map) 309 | map) 310 | "Keymap for `cm-mode'. 311 | This keymap contains only one binding: `C-c *', which is bound to 312 | `cm-prefix-map', the keymap that holds the actual key bindings.") 313 | 314 | (defvar cm-prefix-map) ; Mainly to silence the byte compiler. 315 | (define-prefix-command 'cm-prefix-map) 316 | (define-key cm-prefix-map "a" #'cm-addition) 317 | (define-key cm-prefix-map "d" #'cm-deletion) 318 | (define-key cm-prefix-map "s" #'cm-substitution) 319 | (define-key cm-prefix-map "c" #'cm-comment) 320 | (define-key cm-prefix-map "i" #'cm-accept/reject-change-at-point) 321 | (define-key cm-prefix-map "I" #'cm-accept/reject-all-changes) 322 | (define-key cm-prefix-map "*" #'cm-forward-out-of-change) 323 | (define-key cm-prefix-map "f" #'cm-forward-change) 324 | (define-key cm-prefix-map "b" #'cm-backward-change) 325 | (define-key cm-prefix-map "t" #'cm-set-author) 326 | (define-key cm-prefix-map "F" #'cm-follow-changes) 327 | 328 | (defvar cm-mode-repeat-map 329 | (let ((map (make-sparse-keymap))) 330 | (define-key map (kbd "f") #'cm-forward-change) 331 | (define-key map (kbd "b") #'cm-backward-change) 332 | map) 333 | "Repeat keymap for `cm-mode'.") 334 | (put 'cm-forward-change 'repeat-map 'cm-mode-repeat-map) 335 | (put 'cm-backward-change 'repeat-map 'cm-mode-repeat-map) 336 | 337 | (easy-menu-define cm-mode-menu cm-mode-map "CriticMarkup Menu." 338 | '("CriticMarkup" 339 | ["Addition" cm-addition t] 340 | ["Deletion" cm-deletion t] 341 | ["Substitution" cm-substitution t] 342 | ["Comment" cm-comment t] 343 | "--" 344 | ["Accept/Reject Change" cm-accept/reject-change-at-point t] 345 | ["Accept/Reject All Changes" cm-accept/reject-all-changes t] 346 | "--" 347 | ["Move To Next Change" cm-forward-change t] 348 | ["Move To Previous Change" cm-backward-change t] 349 | "--" 350 | ["Set Author" cm-set-author t])) 351 | 352 | ;;;###autoload 353 | (define-minor-mode cm-mode 354 | "Minor mode for CriticMarkup." 355 | :init-value nil :lighter (:eval (concat " CM" (if cm-author (concat "@" cm-author)) (if cm-follow-changes "*"))) :global nil 356 | (cond 357 | (cm-mode ; `cm-mode' is turned on. 358 | (setq font-lock-multiline t) 359 | (font-lock-add-keywords nil (cm-font-lock-keywords) t) 360 | (when cm-read-only-annotations 361 | (add-to-list 'font-lock-extra-managed-props 'read-only)) 362 | (add-to-list 'font-lock-extra-managed-props 'rear-nonsticky) 363 | (font-lock-ensure) 364 | (setq cm-current-markup-overlay (make-overlay 1 1)) 365 | (overlay-put cm-current-markup-overlay 'face 'highlight)) 366 | ((not cm-mode) ; `cm-mode' is turned off. 367 | (font-lock-remove-keywords nil (cm-font-lock-keywords)) 368 | (setq font-lock-extra-managed-props (delq 'read-only (delq 'rear-nonsticky font-lock-extra-managed-props))) 369 | (let ((modified (buffer-modified-p))) 370 | (cm-make-markups-writable) ; We need to remove the read-only property by hand; it's cumbersome to do it with font-lock. 371 | (unless modified 372 | (set-buffer-modified-p nil))) ; Removing text properties marks the buffer as modified, so we may need to adjust. 373 | (font-lock-ensure) 374 | (remove-overlays)))) 375 | 376 | ;; Making an addition is fairly simple: we just need to add markup if point 377 | ;; isn't already at an addition markup, and then position point 378 | ;; appropriately. The user can then type new text. A deletion is more 379 | ;; difficult, because it also needs to (re)insert the deleted text and do 380 | ;; something sensible with point. This is especially difficult in follow 381 | ;; changes mode, because the deletion may be made with DEL or BACKSPACE. 382 | 383 | (defun cm-addition () 384 | "Make an addition at point. 385 | If point is at an addition markup already, the new addition is 386 | combined with it. If point is inside any other markup, no 387 | addition can be made." 388 | (interactive) 389 | (let ((change (cm-markup-at-point))) 390 | (if (or (not (cm-point-inside-change-p change)) 391 | (cm-addition-p change)) 392 | (cm-without-following-changes 393 | (cm-make-addition change)) 394 | (error "Cannot make an addition here")))) 395 | 396 | (defun cm-deletion (beg end) 397 | "Mark text for deletion. 398 | BEG and END delimit the region to be deleted." 399 | (interactive "r") 400 | (let ((change (cm-markup-at-point))) 401 | (when (cm-point-inside-change-p change) 402 | (error "Cannot make a deletion here")) ; TODO We should check whether the region contains markup. 403 | (when (use-region-p) 404 | (cm-without-following-changes 405 | (cm-make-deletion (delete-and-extract-region beg end)))))) 406 | 407 | (defun cm-make-addition (change) 408 | "Position point for an addition and insert addition markup if necessary. 409 | CHANGE is the change markup at point, if any, as returned by 410 | cm-markup-at-point. If this is an addition, the new addition is 411 | combined with it, even if point is right outside it. This avoids 412 | having two additions adjacent to each other. If it is another 413 | kind of markup, and point is inside the curly braces, we make 414 | sure point is not in the delimiter before adding text." 415 | (setq change (cm-merge-comment change)) 416 | (if (or (cm-point-inside-change-p change) 417 | (and (cm-addition-p change) 418 | (cm-has-current-author-p change))) 419 | (cm-move-into-markup 'cm-addition) 420 | (cm-insert-markup 'cm-addition) 421 | (cm-move-into-markup 'cm-addition t))) 422 | 423 | (defun cm-make-deletion (text &optional backspace) 424 | "Reinsert TEXT into the buffer and add deletion markup if necessary. 425 | TEXT is the text that's being deleted. 426 | 427 | If BACKSPACE is t, the deletion was done with the backspace key; 428 | point will then be left before the deletion markup." 429 | ;; TODO: We should check whether the text to be deleted contains part of 430 | ;; a change. 431 | (let ((change (cm-merge-comment (cm-markup-at-point)))) 432 | (unless (cm-point-inside-change-p change) 433 | (save-excursion 434 | (if (not (and (cm-deletion-p change) 435 | (cm-has-current-author-p change))) 436 | (cm-insert-markup 'cm-deletion text) 437 | (cm-move-into-markup 'cm-deletion) 438 | (insert text))) 439 | ;; `save-excursion' leaves point at the start of the deletion markup. 440 | (unless backspace 441 | (cm-forward-out-of-change))))) 442 | 443 | (defun cm-substitution (beg end) 444 | "Mark a substitution. 445 | BEG and END delimit the text to be substituted." 446 | (interactive "r") 447 | (when (cm-point-inside-change-p (cm-markup-at-point)) 448 | (error "Cannot make a substitution here")) ; TODO We should check whether the region contains markup. 449 | (cm-without-following-changes 450 | (let ((text (delete-and-extract-region beg end))) 451 | (cm-insert-markup 'cm-substitution text) 452 | (cm-move-into-markup 'cm-substitution)))) 453 | 454 | (defun cm-comment (&optional beg end) 455 | "Add a comment. 456 | If the region is active, the text in the region as delimited by 457 | BEG and END, is highlighted. If point is in an existing change, 458 | the comment is added after it." 459 | (interactive "r") 460 | (cm-without-following-changes 461 | (let ((change (cm-markup-at-point)) 462 | text) 463 | (if (or (cm-comment-p change) 464 | (cm-highlight-p change)) 465 | (error "Cannot make a comment here") 466 | (cond 467 | (change 468 | (cm-end-of-markup (car change))) 469 | ;; Note: we do not account for the possibility that the region 470 | ;; contains a change but point is outside of it... 471 | ((use-region-p) 472 | (setq text (delete-and-extract-region beg end)))) 473 | (if text 474 | (cm-insert-markup 'cm-highlight text) 475 | (cm-insert-markup 'cm-comment)) 476 | (cm-move-into-markup 'cm-comment))))) 477 | 478 | (defun cm-point-at-delim (delim &optional end strict) 479 | "Return non-nil if point is at delimiter DELIM. 480 | DELIM should be one of the strings in `cm-delimiters'. If DELIM 481 | is an end delimiter, optional argument END must be t. 482 | 483 | Point counts as being at DELIM if it is in a delimiter or 484 | directly outside, but not when it is directly inside. So `|{++', 485 | `{|++', `{+|+', return 0, 1, and 2 respectively, while `{++|' 486 | returns nil. Similarly, `++}|', `++|}', `+|+}' return 0, 1, and 487 | 2, while `|++}' returns nil. 488 | 489 | If STRICT is non-nil, point must be inside the delimiter. That 490 | is, instead of 0, the return value will be nil." 491 | (save-excursion 492 | (if end 493 | (let ((distance (skip-chars-forward (substring delim 1) (+ (point) 2)))) 494 | (if (looking-back (regexp-quote delim) (- (point) 3)) 495 | (if (> distance 0) 496 | distance 497 | (and (not strict) 0)))) 498 | (let ((distance (skip-chars-backward (substring delim 0 -1) (- (point) 2)))) 499 | (if (looking-at (regexp-quote delim)) 500 | (if (< distance 0) 501 | (abs distance) 502 | (and (not strict) 0))))))) 503 | 504 | (defun cm-forward-markup (type &optional n) 505 | "Move forward to the next markup of TYPE. 506 | Optional argument N indicates how many markups to move. If N is 507 | negative, move backward. If point is inside a delimiter, this 508 | function moves point to the previous/next markup. If point is 509 | inside a markup, it moves to the edge. If point is at the edge 510 | of a markup, it moves to the end of the next markup of the same 511 | type." 512 | (or n (setq n 1)) 513 | (cond 514 | ((> n 0) ; Moving forward. 515 | (let ((delim (car (last (assq type cm-delimiters))))) 516 | (backward-char (- (length delim) (or (cm-point-at-delim delim t t) 517 | (length delim)))) ; Adjust point if it's inside a delimiter. 518 | (re-search-forward (regexp-quote delim) nil t n))) 519 | (t ; Moving backward. 520 | (let ((delim (cl-second (assq type cm-delimiters)))) 521 | (forward-char (- (length delim) (or (cm-point-at-delim delim nil t) 522 | (length delim)))) ; Adjust point if it's inside a delimiter. 523 | (re-search-backward (regexp-quote delim) nil t (abs n)))))) 524 | 525 | (defun cm-beginning-of-markup (type) 526 | "Move to the beginning of a markup of TYPE." 527 | ;; First move out of the delimiter, if we're in one. 528 | (cm-move-past-delim (cl-second (assq type cm-delimiters))) 529 | (cm-forward-markup type -1)) 530 | 531 | (defun cm-end-of-markup (type) 532 | "Move to the end of a markup of TYPE." 533 | ;; First move out of the delimiter, if we're in one. 534 | (cm-move-past-delim (car (last (assq type cm-delimiters))) t) 535 | (cm-forward-markup type)) 536 | 537 | (defun cm-move-past-delim (delim &optional end) 538 | "Move point past DELIM into the markup. 539 | DELIM must be one of the strings in `cm-delimiters'. If DELIM is 540 | an end delimiter, END must be t. If point is not at a delimiter, 541 | do not move. Return t if point has moved." 542 | (let ((len (length delim)) 543 | (pos (point))) 544 | (if end 545 | (backward-char (- len (or (cm-point-at-delim delim end) 546 | len))) 547 | (forward-char (- len (or (cm-point-at-delim delim) 548 | len)))) 549 | (/= pos (point)))) 550 | 551 | (defun cm-move-into-markup (type &optional backwards) 552 | "Make sure point is inside the delimiters of TYPE. 553 | Point is either moved forward if at an opening delimiter or 554 | backward if at a closing delimiter. When moving backward, point 555 | is moved past a comment if the change before the comment is of 556 | TYPE. 557 | 558 | If BACKWARDS is t, only try moving backwards." 559 | (unless (and (not backwards) 560 | (cm-move-past-delim (cl-second (assq type cm-delimiters)))) 561 | (if (and (not (eq type 'cm-comment)) 562 | (cm-comment-p (cm-markup-at-point t))) 563 | (cm-forward-markup 'cm-comment -1)) 564 | (cm-move-past-delim (car (last (assq type cm-delimiters))) t))) 565 | 566 | (defun cm-forward-addition (&optional n) 567 | "Move forward N addition markups. 568 | If N is negative, move backward." 569 | (cm-forward-markup 'cm-addition n)) 570 | 571 | (defun cm-beginning-of-addition () 572 | "Move to the beginning of an addition." 573 | (cm-beginning-of-markup 'cm-addition)) 574 | 575 | (defun cm-end-of-addition () 576 | "Move to the end of an addition." 577 | (cm-end-of-markup 'cm-addition)) 578 | 579 | (put 'cm-addition 'forward-op 'cm-forward-addition) 580 | (put 'cm-addition 'beginning-op 'cm-beginning-of-addition) 581 | (put 'cm-addition 'end-op 'cm-end-of-addition) 582 | 583 | (defun cm-forward-deletion (&optional n) 584 | "Move forward N deletion markups. 585 | If N is negative, move backward." 586 | (cm-forward-markup 'cm-deletion n)) 587 | 588 | (defun cm-beginning-of-deletion () 589 | "Move to the beginning of a deletion." 590 | (cm-beginning-of-markup 'cm-deletion)) 591 | 592 | (defun cm-end-of-deletion () 593 | "Move to the end of a deletion." 594 | (cm-end-of-markup 'cm-deletion)) 595 | 596 | (put 'cm-deletion 'forward-op 'cm-forward-deletion) 597 | (put 'cm-deletion 'beginning-op 'cm-beginning-of-deletion) 598 | (put 'cm-deletion 'end-op 'cm-end-of-deletion) 599 | 600 | (defun cm-forward-substitution (&optional n) 601 | "Move forward N substitution markups. 602 | If N is negative, move backward." 603 | (cm-forward-markup 'cm-substitution n)) 604 | 605 | (defun cm-beginning-of-substitution () 606 | "Move to the beginning of a substitution." 607 | (cm-beginning-of-markup 'cm-substitution)) 608 | 609 | (defun cm-end-of-substitution () 610 | "Move to the end of a substitution." 611 | (cm-end-of-markup 'cm-substitution)) 612 | 613 | (put 'cm-substitution 'forward-op 'cm-forward-substitution) 614 | (put 'cm-substitution 'beginning-op 'cm-beginning-of-substitution) 615 | (put 'cm-substitution 'end-op 'cm-end-of-substitution) 616 | 617 | (defun cm-forward-comment (&optional n) 618 | "Move forward N comment markups. 619 | If N is negative, move backward." 620 | (cm-forward-markup 'cm-comment n)) 621 | 622 | (defun cm-beginning-of-comment () 623 | "Move to the beginning of a comment." 624 | (cm-beginning-of-markup 'cm-comment)) 625 | 626 | (defun cm-end-of-comment () 627 | "Move to the end of a comment." 628 | (cm-end-of-markup 'cm-comment)) 629 | 630 | (put 'cm-comment 'forward-op 'cm-forward-comment) 631 | (put 'cm-comment 'beginning-op 'cm-beginning-of-comment) 632 | (put 'cm-comment 'end-op 'cm-end-of-comment) 633 | 634 | (defun cm-forward-highlight (&optional n) 635 | "Move forward N highlight markups. 636 | If N is negative, move backward." 637 | (cm-forward-markup 'cm-highlight n)) 638 | 639 | (defun cm-beginning-of-highlight () 640 | "Move to the beginning of a highlight." 641 | (cm-beginning-of-markup 'cm-highlight)) 642 | 643 | (defun cm-end-of-highlight () 644 | "Move to the end of a highlight." 645 | (cm-end-of-markup 'cm-highlight)) 646 | 647 | (put 'cm-highlight 'forward-op 'cm-forward-highlight) 648 | (put 'cm-highlight 'beginning-op 'cm-beginning-of-highlight) 649 | (put 'cm-highlight 'end-op 'cm-end-of-highlight) 650 | 651 | (defun cm-bounds-of-markup-at-point (type) 652 | "Return the bounds of markup TYPE at point. 653 | The return value is a list of the form (START-POS END-POS). If 654 | point is not within a markup of TYPE, return nil. 655 | 656 | TYPE is one of `cm-addition', `cm-deletion', `cm-substitution', 657 | `cm-comment', or `cm-highlight'. Note that in the case of 658 | comments, only the comment is returned, any preceding highlight 659 | is ignored. The same holds for highlights: the following comment 660 | is not included." 661 | (if (thing-at-point type) 662 | (let ((beg (save-excursion 663 | (cm-beginning-of-markup type) 664 | (point))) 665 | (end (save-excursion 666 | (cm-end-of-markup type) 667 | (point)))) 668 | (list beg end)))) 669 | 670 | (defun cm-markup-at-point (&optional backward) 671 | "Find the markup at point. 672 | Return a list of the form (TYPE TEXT START-POS END-POS), or nil 673 | if point is not at a markup. 674 | 675 | Note that if point is in between two markups, this function 676 | returns the one that follows point, unless BACKWARD is non-nil." 677 | (let* ((types (delq nil (mapcar #'(lambda (tp) 678 | (if (thing-at-point tp) 679 | tp)) 680 | (mapcar #'car cm-delimiters)))) 681 | (type (if (= (length types) 1) 682 | (car types) 683 | (save-excursion 684 | (forward-char (if backward -1 1)) 685 | (if (thing-at-point (car types)) 686 | (car types) 687 | (cadr types)))))) 688 | (when type 689 | (append (list type) (list (thing-at-point type)) (cm-bounds-of-markup-at-point type))))) 690 | 691 | (defun cm-point-inside-change-p (change) 692 | "Return t if point is inside CHANGE. 693 | CHANGE is a change as returned by `cm-markup-at-point'. Point is 694 | within a change if it's inside the curly braces, not directly 695 | outside of them. The latter counts as being AT a change." 696 | (and change ; if there *is* no change, we're not inside one... 697 | (> (point) (cl-third change)) 698 | (< (point) (cl-fourth change)))) 699 | 700 | (defun cm-extract-comment (change) 701 | "Extract the comment from CHANGE." 702 | (let ((bdelim (regexp-quote (cl-second (assq 'cm-comment cm-delimiters)))) 703 | (edelim (regexp-quote (car (last (assq 'cm-comment cm-delimiters))))) 704 | (text (cl-second change))) 705 | (if (string-match (concat bdelim "\\(\\([[:ascii:]]\\|[[:nonascii:]]\\)*?\\)" edelim) text) 706 | (match-string 1 text)))) 707 | 708 | (defun cm-extract-author (change) 709 | "Extract the author tag of CHANGE. 710 | The author tag should start with an `@' sign, should not contain 711 | any spaces and should be at the start of the comment part of 712 | CHANGE. The return value is the author tag without `@', or nil if 713 | CHANGE has no comment part or a comment without an author." 714 | (let ((comment (cm-extract-comment change))) 715 | (if (and comment 716 | (string-match "^@\\([^[:space:]]*\\)\\([[:ascii:]]\\|[[:nonascii:]]\\)*?$" comment)) 717 | (match-string 1 comment)))) 718 | 719 | (defun cm-has-current-author-p (change) 720 | "Return t if the user is the author of CHANGE. 721 | The user is considered the author of CHANGE if the author tag of 722 | CHANGE matches `cm-author'; if CHANGE has no author; or if 723 | `cm-author' is nil." 724 | (let ((author (cm-extract-author change))) 725 | (or (not cm-author) 726 | (not author) 727 | (string= author cm-author)))) 728 | 729 | (defun cm-merge-comment (change) 730 | "Merge CHANGE and an adjacent comment. 731 | CHANGE is a list as returned by `cm-markup-at-point'. Check if 732 | there is a comment following CHANGE, or, if CHANGE is a comment 733 | itself, check if there is a change preceding CHANGE. If there 734 | is, return an updated list that contains both. If CHANGE is nil, 735 | return nil." 736 | (unless (not change) 737 | (cond 738 | ((cm-comment-p change) 739 | (save-excursion 740 | (cm-beginning-of-comment) 741 | (backward-char 3) ; hard-coded adjustment of point 742 | (let ((preceding (cm-markup-at-point))) 743 | (if preceding 744 | (list (car preceding) (concat (cl-second preceding) (cl-second change)) (cl-third preceding) (cl-fourth change)) 745 | change)))) 746 | (t (save-excursion 747 | (cm-end-of-markup (car change)) 748 | (forward-char 3) ; hard-coded adjustment of point 749 | (let ((comment (cm-markup-at-point))) 750 | (if (cm-comment-p comment) 751 | (list (car change) (concat (cl-second change) (cl-second comment)) (cl-third change) (cl-fourth comment)) 752 | change))))))) 753 | 754 | ;;; Accept/reject changes 755 | 756 | (defun cm-accept/reject-change-at-point (&optional interactive) 757 | "Accept or reject change at point interactively. 758 | If the change is accepted or rejected, return point. If the 759 | change it is skipped, return or the position after the 760 | change (point is not altered in that case). If no change is 761 | found at point, the return value is nil. 762 | 763 | INTERACTIVE is used to determine whether the function was called 764 | interactively or not." 765 | (interactive "p") ; we use "p" to signal that the function was called interactively 766 | (let ((change (cm-markup-at-point))) 767 | (when change 768 | (setq change (cm-merge-comment change)) ; include highlight & comment into one change 769 | (move-overlay cm-current-markup-overlay (cl-third change) (cl-fourth change)) 770 | (let ((action (cond 771 | ((memq (car change) '(cm-addition cm-deletion cm-substitution)) 772 | (read-char-choice (format "%s: (a)ccept/(r)eject/(s)kip%s? " 773 | (capitalize (substring (symbol-name (car change)) 3)) 774 | (if interactive "" "/(q)uit")) 775 | '(?a ?r ?s ?q) t)) 776 | ((memq (car change) '(cm-comment cm-highlight)) 777 | (read-char-choice (format "%s: (d)elete/(s)kip%s? " 778 | (capitalize (substring (symbol-name (car change)) 3)) 779 | (if interactive "" "/(q)uit")) 780 | '(?d ?s ?q) t))))) 781 | (delete-overlay cm-current-markup-overlay) 782 | (when (and (not interactive) (eq action ?q)) ; If the user aborted, 783 | (throw 'quit nil)) ; get out. 784 | (cond 785 | ((memq action '(?a ?r ?d)) 786 | (let ((inhibit-read-only t)) 787 | (cm-without-following-changes 788 | (delete-region (cl-third change) (cl-fourth change)) 789 | (insert (cm-substitution-string change action)))) 790 | (point)) 791 | ((eq action ?s) 792 | (cl-fourth change))))))) 793 | 794 | (defun cm-substitution-string (change action) 795 | "Create the string to substitute CHANGE. 796 | ACTION is a character, either `a' (accept), `r' (reject), or 797 | `d' (delete). `a' and `r' are valid for additions, deletions and 798 | substitutions, `d' for comments and highlights." 799 | (when (eq action ?r) 800 | (setq action nil)) ; When rejecting a change, we don't need to do anything. 801 | (let ((type (cl-first change)) 802 | (text (delete ?\n (cl-second change)))) ; Delete newlines because they mess up string-match below. 803 | (cond 804 | ((eq type 'cm-addition) 805 | (if (not action) 806 | "" 807 | (string-match cm-addition-regexp text) 808 | (match-string 1 text))) 809 | ((eq type 'cm-deletion) 810 | (if action 811 | "" 812 | (string-match cm-deletion-regexp text) 813 | (match-string 1 text))) 814 | ((eq type 'cm-substitution) 815 | (string-match cm-substitution-regexp text) 816 | (match-string (if action 2 1) text)) 817 | ((and (eq type 'cm-comment) 818 | (eq action ?d)) 819 | "") 820 | ((and (eq type 'cm-highlight) 821 | (eq action ?d)) 822 | (string-match cm-highlight-regexp text) 823 | (match-string 1 text))))) 824 | 825 | (defun cm-accept/reject-all-changes () 826 | "Accept/reject all changes interactively." 827 | (interactive) 828 | (catch 'quit 829 | (goto-char (point-min)) 830 | (while (cm-forward-change) 831 | (let ((pos (cm-accept/reject-change-at-point))) 832 | (when pos (goto-char pos)))))) ; move to the end of current change 833 | 834 | ;;; Navigation 835 | 836 | (defun cm-forward-out-of-change () 837 | "Move forward out of the change at point." 838 | (interactive) 839 | (let ((change (cm-merge-comment (cm-markup-at-point)))) 840 | (if change 841 | (goto-char (cl-fourth change))))) 842 | 843 | (defun cm-forward-change (&optional n) 844 | "Move forward to the N'th next change." 845 | (interactive "p") 846 | (or n (setq n 1)) 847 | (funcall (if (> n 0) 848 | #'re-search-forward 849 | #'re-search-backward) 850 | (regexp-opt (mapcar #'cl-second cm-delimiters)) 851 | nil t (abs n))) 852 | 853 | (defun cm-backward-change (&optional n) 854 | "Move backward to the N'th preceding change." 855 | (interactive "p") 856 | (cm-forward-change (- n))) 857 | 858 | (defun cm-set-author (str) 859 | "Set the author string to STR." 860 | (interactive "sSet author to: ") 861 | (setq cm-author (if (string= str "") nil str))) 862 | 863 | ;;; Follow Changes 864 | 865 | (defvar cm-follow-changes nil 866 | "Flag indicating whether follow changes mode is active.") 867 | (make-variable-buffer-local 'cm-follow-changes) 868 | 869 | (defvar cm-current-deletion nil 870 | "The deleted text in follow changes mode. 871 | The value is actually a list consisting of the text and a flag 872 | indicating whether the deletion was done with the backspace 873 | key.") 874 | 875 | (defun cm-follow-changes (&optional arg) 876 | "Activate follow changes mode. 877 | If ARG is positive, activate follow changes mode, if ARG is 0 or 878 | negative, deactivate it. If ARG is `toggle', toggle follow 879 | changes mode." 880 | (interactive (list (or current-prefix-arg 'toggle))) 881 | (let ((enable (if (eq arg 'toggle) 882 | (not cm-follow-changes) 883 | (> (prefix-numeric-value arg) 0)))) 884 | (if enable 885 | (progn 886 | (add-to-list 'before-change-functions 'cm-before-change t) 887 | (add-to-list 'after-change-functions 'cm-after-change) 888 | (setq cm-follow-changes t) 889 | (message "Follow changes mode activated.")) 890 | (setq before-change-functions (delq 'cm-before-change before-change-functions)) 891 | (setq after-change-functions (delq 'cm-after-change after-change-functions)) 892 | (setq cm-follow-changes nil) 893 | (message "Follow changes mode deactivated.")))) 894 | 895 | (defun cm-before-change (beg end) 896 | "Function to execute before a buffer change. 897 | BEG and END are the beginning and the end of the region to be 898 | changed." 899 | (unless (or undo-in-progress 900 | (and (= beg (point-min)) (= end (point-max)))) ; This happens on buffer switches. 901 | (if (= beg end) ; Addition. 902 | (cm-make-addition (cm-markup-at-point)) 903 | ;; When the deletion was done with backspace, point is at end. We record 904 | ;; this in `cm-current-deletion' so we can position point correctly. 905 | (setq cm-current-deletion (list (buffer-substring beg end) (= (point) end)))))) 906 | 907 | (defun cm-after-change (beg end length) 908 | "Function to execute after a buffer change. 909 | This function marks deletions. See cm-before-change for details. 910 | BEG and END mark the region to be changed, LENGTH is the length 911 | of the affected text." 912 | (unless (or undo-in-progress 913 | (not cm-current-deletion)) 914 | (apply #'cm-make-deletion cm-current-deletion) 915 | (setq cm-current-deletion nil))) 916 | 917 | (provide 'cm-mode) 918 | 919 | ;;; cm-mode.el ends here 920 | --------------------------------------------------------------------------------