branch: externals/cm-mode
commit a9381f57f3005a9b26f81085ecb2accf680c6f6b
Author: Joost Kremers <[email protected]>
Commit: Joost Kremers <[email protected]>
Arrange code more logically
---
cm-mode.el | 256 +++++++++++++++++++++++++++++++------------------------------
1 file changed, 131 insertions(+), 125 deletions(-)
diff --git a/cm-mode.el b/cm-mode.el
index fa547c2348..43c705a9f8 100644
--- a/cm-mode.el
+++ b/cm-mode.el
@@ -199,76 +199,6 @@ and reactivate `cm-mode'."
(eq (car change) (quote ,markup)))))
(mapcar #'car cm-delimiters)))
-(defvar cm-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c *") 'cm-prefix-map)
- map)
- "Keymap for `cm-mode'.
-This keymap contains only one binding: `C-c *', which is bound to
-`cm-prefix-map', the keymap that holds the actual key bindings.")
-
-(defvar cm-prefix-map) ; Mainly to silence the byte compiler.
-(define-prefix-command 'cm-prefix-map)
-(define-key cm-prefix-map "a" #'cm-addition)
-(define-key cm-prefix-map "d" #'cm-deletion)
-(define-key cm-prefix-map "s" #'cm-substitution)
-(define-key cm-prefix-map "c" #'cm-comment)
-(define-key cm-prefix-map "i" #'cm-accept/reject-change-at-point)
-(define-key cm-prefix-map "I" #'cm-accept/reject-all-changes)
-(define-key cm-prefix-map "*" #'cm-forward-out-of-change)
-(define-key cm-prefix-map "f" #'cm-forward-change)
-(define-key cm-prefix-map "b" #'cm-backward-change)
-(define-key cm-prefix-map "t" #'cm-set-author)
-(define-key cm-prefix-map "F" #'cm-follow-changes)
-
-(defvar cm-mode-repeat-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "f") #'cm-forward-change)
- (define-key map (kbd "b") #'cm-backward-change)
- map)
- "Repeat keymap for `cm-mode'.")
-(put 'cm-forward-change 'repeat-map 'cm-mode-repeat-map)
-(put 'cm-backward-change 'repeat-map 'cm-mode-repeat-map)
-
-(easy-menu-define cm-mode-menu cm-mode-map "CriticMarkup Menu."
- '("CriticMarkup"
- ["Addition" cm-addition t]
- ["Deletion" cm-deletion t]
- ["Substitution" cm-substitution t]
- ["Comment" cm-comment t]
- "--"
- ["Accept/Reject Change" cm-accept/reject-change-at-point t]
- ["Accept/Reject All Changes" cm-accept/reject-all-changes t]
- "--"
- ["Move To Next Change" cm-forward-change t]
- ["Move To Previous Change" cm-backward-change t]
- "--"
- ["Set Author" cm-set-author t]))
-
-;;;###autoload
-(define-minor-mode cm-mode
- "Minor mode for CriticMarkup."
- :init-value nil :lighter (:eval (concat " CM" (if cm-author (concat "@"
cm-author)) (if cm-follow-changes "*"))) :global nil
- (cond
- (cm-mode ; `cm-mode' is turned on.
- (setq font-lock-multiline t)
- (font-lock-add-keywords nil (cm-font-lock-keywords) t)
- (when cm-read-only-annotations
- (add-to-list 'font-lock-extra-managed-props 'read-only))
- (add-to-list 'font-lock-extra-managed-props 'rear-nonsticky)
- (font-lock-ensure)
- (setq cm-current-markup-overlay (make-overlay 1 1))
- (overlay-put cm-current-markup-overlay 'face 'highlight))
- ((not cm-mode) ; `cm-mode' is turned off.
- (font-lock-remove-keywords nil (cm-font-lock-keywords))
- (setq font-lock-extra-managed-props (delq 'read-only (delq 'rear-nonsticky
font-lock-extra-managed-props)))
- (let ((modified (buffer-modified-p)))
- (cm-make-markups-writable) ; We need to remove the read-only property
by hand; it's cumbersome to do it with font-lock.
- (unless modified
- (set-buffer-modified-p nil))) ; Removing text properties marks the
buffer as modified, so we may need to adjust.
- (font-lock-ensure)
- (remove-overlays))))
-
;;; Font lock
(defun cm-font-lock-for-markup (type)
@@ -317,59 +247,7 @@ This keymap contains only one binding: `C-c *', which is
bound to
"Return a list of font lock keywords."
(mapcar #'cm-font-lock-for-markup cm-delimiters))
-;;; Follow Changes
-
-(defvar cm-follow-changes nil
- "Flag indicating whether follow changes mode is active.")
-(make-variable-buffer-local 'cm-follow-changes)
-
-(defvar cm-current-deletion nil
- "The deleted text in follow changes mode.
-The value is actually a list consisting of the text and a flag
-indicating whether the deletion was done with the backspace
-key.")
-
-(defun cm-follow-changes (&optional arg)
- "Activate follow changes mode.
-If ARG is positive, activate follow changes mode, if ARG is 0 or
-negative, deactivate it. If ARG is `toggle', toggle follow
-changes mode."
- (interactive (list (or current-prefix-arg 'toggle)))
- (let ((enable (if (eq arg 'toggle)
- (not cm-follow-changes)
- (> (prefix-numeric-value arg) 0))))
- (if enable
- (progn
- (add-to-list 'before-change-functions 'cm-before-change t)
- (add-to-list 'after-change-functions 'cm-after-change)
- (setq cm-follow-changes t)
- (message "Follow changes mode activated."))
- (setq before-change-functions (delq 'cm-before-change
before-change-functions))
- (setq after-change-functions (delq 'cm-after-change
after-change-functions))
- (setq cm-follow-changes nil)
- (message "Follow changes mode deactivated."))))
-
-(defun cm-before-change (beg end)
- "Function to execute before a buffer change.
-BEG and END are the beginning and the end of the region to be
-changed."
- (unless (or undo-in-progress
- (and (= beg (point-min)) (= end (point-max)))) ; This happens
on buffer switches.
- (if (= beg end) ; Addition.
- (cm-make-addition (cm-markup-at-point))
- ;; When the deletion was done with backspace, point is at end. We record
- ;; this in `cm-current-deletion' so we can position point correctly.
- (setq cm-current-deletion (list (buffer-substring beg end) (= (point)
end))))))
-
-(defun cm-after-change (beg end length)
- "Function to execute after a buffer change.
-This function marks deletions. See cm-before-change for details.
-BEG and END mark the region to be changed, LENGTH is the length
-of the affected text."
- (unless (or undo-in-progress
- (not cm-current-deletion))
- (apply #'cm-make-deletion cm-current-deletion)
- (setq cm-current-deletion nil)))
+;;; Utility functions
(defmacro cm-without-following-changes (&rest body)
"Execute BODY without following changes."
@@ -423,6 +301,78 @@ starts with `cm-author'."
"")
"<<}")))
+;;; User functions
+
+(defvar cm-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c *") 'cm-prefix-map)
+ map)
+ "Keymap for `cm-mode'.
+This keymap contains only one binding: `C-c *', which is bound to
+`cm-prefix-map', the keymap that holds the actual key bindings.")
+
+(defvar cm-prefix-map) ; Mainly to silence the byte compiler.
+(define-prefix-command 'cm-prefix-map)
+(define-key cm-prefix-map "a" #'cm-addition)
+(define-key cm-prefix-map "d" #'cm-deletion)
+(define-key cm-prefix-map "s" #'cm-substitution)
+(define-key cm-prefix-map "c" #'cm-comment)
+(define-key cm-prefix-map "i" #'cm-accept/reject-change-at-point)
+(define-key cm-prefix-map "I" #'cm-accept/reject-all-changes)
+(define-key cm-prefix-map "*" #'cm-forward-out-of-change)
+(define-key cm-prefix-map "f" #'cm-forward-change)
+(define-key cm-prefix-map "b" #'cm-backward-change)
+(define-key cm-prefix-map "t" #'cm-set-author)
+(define-key cm-prefix-map "F" #'cm-follow-changes)
+
+(defvar cm-mode-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "f") #'cm-forward-change)
+ (define-key map (kbd "b") #'cm-backward-change)
+ map)
+ "Repeat keymap for `cm-mode'.")
+(put 'cm-forward-change 'repeat-map 'cm-mode-repeat-map)
+(put 'cm-backward-change 'repeat-map 'cm-mode-repeat-map)
+
+(easy-menu-define cm-mode-menu cm-mode-map "CriticMarkup Menu."
+ '("CriticMarkup"
+ ["Addition" cm-addition t]
+ ["Deletion" cm-deletion t]
+ ["Substitution" cm-substitution t]
+ ["Comment" cm-comment t]
+ "--"
+ ["Accept/Reject Change" cm-accept/reject-change-at-point t]
+ ["Accept/Reject All Changes" cm-accept/reject-all-changes t]
+ "--"
+ ["Move To Next Change" cm-forward-change t]
+ ["Move To Previous Change" cm-backward-change t]
+ "--"
+ ["Set Author" cm-set-author t]))
+
+;;;###autoload
+(define-minor-mode cm-mode
+ "Minor mode for CriticMarkup."
+ :init-value nil :lighter (:eval (concat " CM" (if cm-author (concat "@"
cm-author)) (if cm-follow-changes "*"))) :global nil
+ (cond
+ (cm-mode ; `cm-mode' is turned on.
+ (setq font-lock-multiline t)
+ (font-lock-add-keywords nil (cm-font-lock-keywords) t)
+ (when cm-read-only-annotations
+ (add-to-list 'font-lock-extra-managed-props 'read-only))
+ (add-to-list 'font-lock-extra-managed-props 'rear-nonsticky)
+ (font-lock-ensure)
+ (setq cm-current-markup-overlay (make-overlay 1 1))
+ (overlay-put cm-current-markup-overlay 'face 'highlight))
+ ((not cm-mode) ; `cm-mode' is turned off.
+ (font-lock-remove-keywords nil (cm-font-lock-keywords))
+ (setq font-lock-extra-managed-props (delq 'read-only (delq 'rear-nonsticky
font-lock-extra-managed-props)))
+ (let ((modified (buffer-modified-p)))
+ (cm-make-markups-writable) ; We need to remove the read-only property
by hand; it's cumbersome to do it with font-lock.
+ (unless modified
+ (set-buffer-modified-p nil))) ; Removing text properties marks the
buffer as modified, so we may need to adjust.
+ (font-lock-ensure)
+ (remove-overlays))))
+
;; Making an addition is fairly simple: we just need to add markup if point
;; isn't already at an addition markup, and then position point
;; appropriately. The user can then type new text. A deletion is more
@@ -801,6 +751,8 @@ return nil."
(list (car change) (concat (cl-second change) (cl-second
comment)) (cl-third change) (cl-fourth comment))
change)))))))
+;;; Accept/reject changes
+
(defun cm-accept/reject-change-at-point (&optional interactive)
"Accept or reject change at point interactively.
If the change is accepted or rejected, return point. If the
@@ -827,8 +779,8 @@ interactively or not."
(if interactive "" "/(q)uit"))
'(?d ?s ?q) t)))))
(delete-overlay cm-current-markup-overlay)
- (when (and (not interactive) (eq action ?q)) ; If the user aborted,
- (throw 'quit nil)) ; get out.
+ (when (and (not interactive) (eq action ?q)) ; If the user aborted,
+ (throw 'quit nil)) ; get out.
(cond
((memq action '(?a ?r ?d))
(let ((inhibit-read-only t))
@@ -908,6 +860,60 @@ substitutions, `d' for comments and highlights."
(interactive "sSet author to: ")
(setq cm-author (if (string= str "") nil str)))
+;;; Follow Changes
+
+(defvar cm-follow-changes nil
+ "Flag indicating whether follow changes mode is active.")
+(make-variable-buffer-local 'cm-follow-changes)
+
+(defvar cm-current-deletion nil
+ "The deleted text in follow changes mode.
+The value is actually a list consisting of the text and a flag
+indicating whether the deletion was done with the backspace
+key.")
+
+(defun cm-follow-changes (&optional arg)
+ "Activate follow changes mode.
+If ARG is positive, activate follow changes mode, if ARG is 0 or
+negative, deactivate it. If ARG is `toggle', toggle follow
+changes mode."
+ (interactive (list (or current-prefix-arg 'toggle)))
+ (let ((enable (if (eq arg 'toggle)
+ (not cm-follow-changes)
+ (> (prefix-numeric-value arg) 0))))
+ (if enable
+ (progn
+ (add-to-list 'before-change-functions 'cm-before-change t)
+ (add-to-list 'after-change-functions 'cm-after-change)
+ (setq cm-follow-changes t)
+ (message "Follow changes mode activated."))
+ (setq before-change-functions (delq 'cm-before-change
before-change-functions))
+ (setq after-change-functions (delq 'cm-after-change
after-change-functions))
+ (setq cm-follow-changes nil)
+ (message "Follow changes mode deactivated."))))
+
+(defun cm-before-change (beg end)
+ "Function to execute before a buffer change.
+BEG and END are the beginning and the end of the region to be
+changed."
+ (unless (or undo-in-progress
+ (and (= beg (point-min)) (= end (point-max)))) ; This happens
on buffer switches.
+ (if (= beg end) ; Addition.
+ (cm-make-addition (cm-markup-at-point))
+ ;; When the deletion was done with backspace, point is at end. We record
+ ;; this in `cm-current-deletion' so we can position point correctly.
+ (setq cm-current-deletion (list (buffer-substring beg end) (= (point)
end))))))
+
+(defun cm-after-change (beg end length)
+ "Function to execute after a buffer change.
+This function marks deletions. See cm-before-change for details.
+BEG and END mark the region to be changed, LENGTH is the length
+of the affected text."
+ (unless (or undo-in-progress
+ (not cm-current-deletion))
+ (apply #'cm-make-deletion cm-current-deletion)
+ (setq cm-current-deletion nil)))
+
(provide 'cm-mode)
;;; cm-mode.el ends here
