-;;; hilit-chg.el --- minor mode displaying buffer changes with special face
+;;; hilit-chg.el --- minor mode displaying buffer changes with special face -*- lexical-binding: t -*-
;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; (defun my-highlight-changes-mode-hook ()
;; (if highlight-changes-mode
;; (add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t)
-;; (remove-hook 'write-file-functions 'highlight-changes-rotate-faces t)
-;; ))
+;; (remove-hook 'write-file-functions 'highlight-changes-rotate-faces t)))
;; Automatically enabling Highlight Changes mode
;; Possible bindings:
-;; (global-set-key '[C-right] 'highlight-changes-next-change)
-;; (global-set-key '[C-left] 'highlight-changes-previous-change)
+;; (global-set-key '[C-right] #'highlight-changes-next-change)
+;; (global-set-key '[C-left] #'highlight-changes-previous-change)
;;
;; Other interactive functions (that could be bound if desired):
-;; highlight-changes-mode
-;; highlight-changes-toggle-visibility
-;; highlight-changes-remove-highlight
-;; highlight-compare-with-file
-;; highlight-compare-buffers
-;; highlight-changes-rotate-faces
+;; `highlight-changes-mode'
+;; `highlight-changes-toggle-visibility'
+;; `highlight-changes-remove-highlight'
+;; `highlight-compare-with-file'
+;; `highlight-compare-buffers'
+;; `highlight-changes-rotate-faces'
;;; Bugs:
:version "20.4"
:group 'faces)
-
;; Face information: How the changes appear.
;; Defaults for face: red foreground, no change to background,
'((((min-colors 88) (class color)) (:foreground "red1"))
(((class color)) (:foreground "red" ))
(t (:inverse-video t)))
- "Face used for highlighting changes."
- :group 'highlight-changes)
+ "Face used for highlighting changes.")
;; This looks pretty ugly, actually. Maybe the underline should be removed.
(defface highlight-changes-delete
'((((min-colors 88) (class color)) (:foreground "red1" :underline t))
(((class color)) (:foreground "red" :underline t))
(t (:inverse-video t)))
- "Face used for highlighting deletions."
- :group 'highlight-changes)
+ "Face used for highlighting deletions.")
;; A (not very good) default list of colors to rotate through.
(defcustom highlight-changes-colors
(if (eq (frame-parameter nil 'background-mode) 'light)
;; defaults for light background:
- '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
+ '("magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
;; defaults for dark background:
'("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))
"Colors used by `highlight-changes-rotate-faces'.
variable overrides this list. If you only care about foreground
colors then use this, if you want fancier faces then set
`highlight-changes-face-list'."
- :type '(repeat color)
- :group 'highlight-changes)
+ :type '(repeat color))
;; When you invoke highlight-changes-mode, should highlight-changes-visible-mode
;; be on or off?
This controls the initial value of `highlight-changes-visible-mode'.
When a buffer is in Highlight Changes mode the function
`highlight-changes-visible-mode' is used to toggle the mode on or off."
- :type 'boolean
- :group 'highlight-changes)
+ :type 'boolean)
;; These are the strings displayed in the mode-line for the minor mode:
This should be set to nil if no indication is desired, or to
a string with a leading space."
:type '(choice string
- (const :tag "None" nil))
- :group 'highlight-changes)
+ (const :tag "None" nil)))
(defcustom highlight-changes-invisible-string " -Chg"
"The string used when in Highlight Changes mode and changes are hidden.
This should be set to nil if no indication is desired, or to
a string with a leading space."
:type '(choice string
- (const :tag "None" nil))
- :group 'highlight-changes)
+ (const :tag "None" nil)))
(defcustom highlight-changes-global-modes t
"Determine whether a buffer is suitable for global Highlight Changes mode.
(repeat :tag "Modes" :inline t (symbol :tag "mode")))
(function :menu-tag "determined by function"
:value buffer-file-name)
- (const :tag "none" nil)
- )
- :group 'highlight-changes)
+ (const :tag "none" nil)))
(defcustom highlight-changes-global-changes-existing-buffers nil
"If non-nil, toggling global Highlight Changes mode affects existing buffers.
is non-nil, then turning on `global-highlight-changes-mode' will turn on
Highlight Changes mode in suitable buffers, and turning the mode off will
remove it from existing buffers."
- :type 'boolean
- :group 'highlight-changes)
+ :type 'boolean)
;; These are for internal use.
\\[highlight-compare-with-file] - mark text as changed by comparing this
buffer with the contents of a file
\\[highlight-compare-buffers] highlights differences between two buffers."
- nil ;; init-value
- hilit-chg-string ;; lighter
- nil ;; keymap
+ :lighter hilit-chg-string
(if (or (display-color-p)
(and (fboundp 'x-display-grayscale-p) (x-display-grayscale-p)))
(progn
`highlight-changes-visibility-initial-state'.
This command does not itself set Highlight Changes mode."
-
- t ;; init-value
- nil ;; lighter
- nil ;; keymap
-
- (hilit-chg-update)
- )
+ :init-value t
+ (hilit-chg-update))
(defun hilit-chg-cust-fix-changes-face-list (w _wc &optional event)
;; faces are saved but not to the actual list itself.
(let ((old-list (widget-value w)))
(if (member 'default old-list)
- (let
- ((p (reverse old-list))
+ (let ((p (reverse old-list))
(n (length old-list))
new-name old-name
- (new-list nil)
- )
+ (new-list nil))
(while p
(setq old-name (car p))
(setq new-name (intern (format "highlight-changes-%d" n)))
(if (equal new-list (widget-value w))
nil ;; (message "notify: no change!")
(widget-value-set w new-list)
- (widget-setup)
- )
- )
+ (widget-setup)))
;; (message "notify: no default here!")
))
(let ((parent (widget-get w :parent)))
:type '(choice
(repeat
:notify hilit-chg-cust-fix-changes-face-list
- face )
- (const :tag "Derive from highlight-changes-colors" nil)
- )
- :group 'highlight-changes)
+ face)
+ (const :tag "Derive from highlight-changes-colors" nil)))
(defun hilit-chg-map-changes (func &optional start-position end-position)
from the information in the text property of type `hilit-chg'.
This is the opposite of `hilit-chg-hide-changes'."
- (hilit-chg-map-changes 'hilit-chg-make-ov beg end))
+ (hilit-chg-map-changes #'hilit-chg-make-ov beg end))
(defun hilit-chg-make-ov (prop start end)
(overlay-put ov 'evaporate t)
;; We set the change property so we can tell this is one
;; of our overlays (so we don't delete someone else's).
- (overlay-put ov 'hilit-chg t)
- )
+ (overlay-put ov 'hilit-chg t))
(error "hilit-chg-make-ov: no face for prop: %s" prop))))
(defun hilit-chg-hide-changes (&optional beg end)
;; remove our existing overlays
(hilit-chg-hide-changes)
;; for each change text property, increment it
- (hilit-chg-map-changes 'hilit-chg-bump-change)
+ (hilit-chg-map-changes #'hilit-chg-bump-change)
;; and display them
(hilit-chg-display-changes))
(unless modified
(buf-b-read-only (with-current-buffer buf-b buffer-read-only))
temp-a temp-b)
(if (and file-a bufa-modified)
- (if (y-or-n-p (format "Save buffer %s? " buf-a))
+ (if (y-or-n-p (format "Save buffer %s? " buf-a))
(with-current-buffer buf-a
(save-buffer)
(setq bufa-modified (buffer-modified-p buf-a)))
(setq temp-a (setq file-a (ediff-make-temp-file buf-a nil))))
(if (and file-b bufb-modified)
- (if (y-or-n-p (format "Save buffer %s? " buf-b))
+ (if (y-or-n-p (format "Save buffer %s? " buf-b))
(with-current-buffer buf-b
(save-buffer)
(setq bufb-modified (buffer-modified-p buf-b)))
(if temp-a
(delete-file temp-a))
(if temp-b
- (delete-file temp-b)))
- ))
+ (delete-file temp-b)))))
;;;###autoload
(defun highlight-compare-buffers (buf-a buf-b)
-"Compare two buffers and highlight the differences.
+ "Compare two buffers and highlight the differences.
The default is the current buffer and the one in the next window.
(window-buffer (next-window)) t))))
(let ((file-a (buffer-file-name buf-a))
(file-b (buffer-file-name buf-b)))
- (highlight-markup-buffers buf-a file-a buf-b file-b)
- ))
+ (highlight-markup-buffers buf-a file-a buf-b file-b)))
;;;###autoload
(defun highlight-compare-with-file (file-b)
(find-file-noselect file-b))))
(highlight-markup-buffers buf-a file-a buf-b file-b (not existing-buf))
(unless existing-buf
- (kill-buffer buf-b))
- ))
+ (kill-buffer buf-b))))
+(defvar hilit-x) ; placate the byte-compiler
+(defvar hilit-y)
+(defvar hilit-e)
(defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b)
;; hilit-e,x,y are set by function hilit-chg-get-diff-list-hk.
(ediff-setup buf-a file-a buf-b file-b
nil nil ; buf-c file-C
'(hilit-chg-get-diff-list-hk)
- (list (cons 'ediff-job-name 'something))
- )
+ (list (cons 'ediff-job-name 'something)))
(ediff-with-current-buffer hilit-e (ediff-really-quit nil))
(list hilit-x hilit-y)))
(defun hilit-chg-get-diff-list-hk ()
;; hilit-e/x/y are dynamically bound by hilit-chg-get-diff-info
;; which calls this function as a hook.
- (defvar hilit-x) ; placate the byte-compiler
- (defvar hilit-y)
- (defvar hilit-e)
(setq hilit-e (current-buffer))
(let ((n 0) extent p va vb a b)
(setq hilit-x nil hilit-y nil)
(setq extent (list (overlay-start (car p))
(overlay-end (car p))))
(setq p (cdr p))
- (setq hilit-y (append hilit-y (list extent) )))
+ (setq hilit-y (append hilit-y (list extent))))
(setq n (1+ n)));; while
;; ediff-quit doesn't work here.
;; No point in returning a value, since this is a hook function.
(and
(not (string-match "^[ *]" (buffer-name)))
(buffer-file-name))))
- (highlight-changes-mode 1))
- ))
+ (highlight-changes-mode 1))))
;;;; Desktop support.
;; (message "--- hilit-chg-debug-show ---")
;; (hilit-chg-map-changes (lambda (prop start end)
;; (message "%d-%d: %s" start end prop))
-;; beg end
-;; ))
+;; beg end))
;;
;; ================== end of debug ===============