X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/9850eff524bd0747a9561f3b4c90dfc3749f4ecb..ab422c4d6899b1442cb6954c1829c1fb656b006c:/lisp/hilit-chg.el diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 0f84a0406a..66440ef1cf 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -1,7 +1,6 @@ ;;; hilit-chg.el --- minor mode displaying buffer changes with special face -;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc. ;; Author: Richard Sharman ;; Keywords: faces @@ -195,8 +194,8 @@ (t (:inverse-video t))) "Face used for highlighting changes." :group 'highlight-changes) -;; backward-compatibility alias -(put 'highlight-changes-face 'face-alias 'highlight-changes) +(define-obsolete-face-alias 'highlight-changes-face + 'highlight-changes "22.1") ;; This looks pretty ugly, actually. Maybe the underline should be removed. (defface highlight-changes-delete @@ -205,13 +204,11 @@ (t (:inverse-video t))) "Face used for highlighting deletions." :group 'highlight-changes) -;; backward-compatibility alias -(put 'highlight-changes-delete-face 'face-alias 'highlight-changes-delete) - +(define-obsolete-face-alias 'highlight-changes-delete-face + 'highlight-changes-delete "22.1") ;; A (not very good) default list of colors to rotate through. -;; (define-obsolete-variable-alias 'highlight-changes-colours 'highlight-changes-colors "22.1") @@ -329,14 +326,15 @@ remove it from existing buffers." ;;;###autoload (define-minor-mode highlight-changes-mode - "Toggle Highlight Changes mode. - -With ARG, turn Highlight Changes mode on if and only if arg is positive. + "Toggle highlighting changes in this buffer (Highlight Changes mode). +With a prefix argument ARG, enable Highlight Changes mode if ARG +is positive, and disable it otherwise. If called from Lisp, +enable the mode if ARG is omitted or nil. -In Highlight Changes mode changes are recorded with a text property. -Normally they are displayed in a distinctive face, but command -\\[highlight-changes-visible-mode] can be used to toggles this -on and off. +When Highlight Changes is enabled, changes are marked with a text +property. Normally they are displayed in a distinctive face, but +command \\[highlight-changes-visible-mode] can be used to toggles +this on and off. Other functions for buffers in this mode include: \\[highlight-changes-next-change] - move point to beginning of next change @@ -369,14 +367,17 @@ buffer with the contents of a file ;;;###autoload (define-minor-mode highlight-changes-visible-mode - "Toggle visiblility of changes when buffer is in Highlight Changes mode. + "Toggle visibility of highlighting due to Highlight Changes mode. +With a prefix argument ARG, enable Highlight Changes Visible mode +if ARG is positive, and disable it otherwise. If called from +Lisp, enable the mode if ARG is omitted or nil. -This mode only has an effect when Highlight Changes mode is on. -It allows toggling between whether or not the changed text is displayed +Highlight Changes Visible mode only has an effect when Highlight +Changes mode is on. When enabled, the changed text is displayed in a distinctive face. The default value can be customized with variable -`highlight-changes-visibility-initial-state' +`highlight-changes-visibility-initial-state'. This command does not itself set highlight-changes mode." @@ -388,7 +389,7 @@ This command does not itself set highlight-changes mode." ) -(defun hilit-chg-cust-fix-changes-face-list (w wc &optional event) +(defun hilit-chg-cust-fix-changes-face-list (w _wc &optional event) ;; When customization function `highlight-changes-face-list' inserts a new ;; face it uses the default face. We don't want the user to modify this ;; face, so we rename the faces in the list on an insert. The rename is @@ -479,7 +480,7 @@ This is the opposite of `hilit-chg-hide-changes'." (defun hilit-chg-make-ov (prop start end) (or prop (error "hilit-chg-make-ov: prop is nil")) - ;; For the region create overlays with a distincive face + ;; For the region create overlays with a distinctive face ;; and the text property 'hilit-chg. (let ((ov (make-overlay start end)) (face (if (eq prop 'hilit-chg-delete) @@ -560,45 +561,47 @@ This allows you to manually remove highlighting from uninteresting changes." ;; otherwise an undone change shows up as changed. While the properties ;; are automatically restored by undo, we must fix up the overlay. (save-match-data - (let ((beg-decr 1) (end-incr 1) - (type 'hilit-chg) - old) + (let (;;(beg-decr 1) + (end-incr 1) + (type 'hilit-chg)) (if undo-in-progress (if (and highlight-changes-mode highlight-changes-visible-mode) (hilit-chg-fixup beg end)) (highlight-save-buffer-state - (if (and (= beg end) (> leng-before 0)) - ;; deletion - (progn - ;; The eolp and bolp tests are a kludge! But they prevent - ;; rather nasty looking displays when deleting text at the end - ;; of line, such as normal corrections as one is typing and - ;; immediately makes a correction, and when deleting first - ;; character of a line. - ;; (if (= leng-before 1) - ;; (if (eolp) - ;; (setq beg-decr 0 end-incr 0) - ;; (if (bolp) - ;; (setq beg-decr 0)))) - ;; (setq beg (max (- beg beg-decr) (point-min))) - (setq end (min (+ end end-incr) (point-max))) - (setq type 'hilit-chg-delete)) - ;; Not a deletion. - ;; Most of the time the following is not necessary, but - ;; if the current text was marked as a deletion then - ;; the old overlay is still in effect, so if we add some - ;; text then remove the deletion marking, but set it to - ;; changed otherwise its highlighting disappears. - (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete) - (progn - (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg) - (if highlight-changes-visible-mode - (hilit-chg-fixup beg (+ end 1)))))) - (unless no-property-change - (put-text-property beg end 'hilit-chg type)) - (if (or highlight-changes-visible-mode no-property-change) - (hilit-chg-make-ov type beg end))))))) + (if (and (= beg end) (> leng-before 0)) + ;; deletion + (progn + ;; The eolp and bolp tests are a kludge! But they prevent + ;; rather nasty looking displays when deleting text at the end + ;; of line, such as normal corrections as one is typing and + ;; immediately makes a correction, and when deleting first + ;; character of a line. + ;; (if (= leng-before 1) + ;; (if (eolp) + ;; (setq beg-decr 0 end-incr 0) + ;; (if (bolp) + ;; (setq beg-decr 0)))) + ;; (setq beg (max (- beg beg-decr) (point-min))) + (setq end (min (+ end end-incr) (point-max))) + (setq type 'hilit-chg-delete)) + ;; Not a deletion. + ;; Most of the time the following is not necessary, but + ;; if the current text was marked as a deletion then + ;; the old overlay is still in effect. So if the user adds some + ;; text where she earlier deleted text, we have to remove the + ;; deletion marking, and replace it explicitly with a `changed' + ;; marking, otherwise its highlighting would disappear. + (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete) + (save-restriction + (widen) + (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg) + (if highlight-changes-visible-mode + (hilit-chg-fixup beg (+ end 1)))))) + (unless no-property-change + (put-text-property beg end 'hilit-chg type)) + (if (or highlight-changes-visible-mode no-property-change) + (hilit-chg-make-ov type beg end))))))) (defun hilit-chg-update () "Update a buffer's highlight changes when visibility changed." @@ -635,7 +638,7 @@ This removes all saved change information." (highlight-save-buffer-state (hilit-chg-hide-changes) (hilit-chg-map-changes - (lambda (prop start stop) + (lambda (_prop start stop) (remove-text-properties start stop '(hilit-chg nil))))) (setq highlight-changes-mode nil) (force-mode-line-update))) @@ -914,8 +917,7 @@ changes are made, so \\[highlight-changes-next-change] and (file-a (buffer-file-name)) (existing-buf (get-file-buffer file-b)) (buf-b (or existing-buf - (find-file-noselect file-b))) - (buf-b-read-only (with-current-buffer buf-b buffer-read-only))) + (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)) @@ -923,24 +925,26 @@ changes are made, so \\[highlight-changes-next-change] and (defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b) - (let ((e nil) x y) ;; e is set by function hilit-chg-get-diff-list-hk + ;; hilit-e,x,y are set by function hilit-chg-get-diff-list-hk. + (let (hilit-e hilit-x hilit-y) (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)) ) - (ediff-with-current-buffer e (ediff-really-quit nil)) - (list x y))) + (ediff-with-current-buffer hilit-e (ediff-really-quit nil)) + (list hilit-x hilit-y))) (defun hilit-chg-get-diff-list-hk () - ;; x and y are dynamically bound by hilit-chg-get-diff-info - ;; which calls this function as a hook - (defvar x) ;; placate the byte-compiler - (defvar y) - (setq e (current-buffer)) + ;; 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 x nil y nil) ;; x and y are bound by hilit-chg-get-diff-info + (setq hilit-x nil hilit-y nil) (while (< n ediff-number-of-differences) (ediff-make-fine-diffs n) (setq va (ediff-get-fine-diff-vector n 'A)) @@ -956,7 +960,7 @@ changes are made, so \\[highlight-changes-next-change] and (setq extent (list (overlay-start (car p)) (overlay-end (car p)))) (setq p (cdr p)) - (setq x (append x (list extent) )));; while p + (setq hilit-x (append hilit-x (list extent) )));; while p ;; (setq vb (ediff-get-fine-diff-vector n 'B)) ;; vb is a vector @@ -971,7 +975,7 @@ changes are made, so \\[highlight-changes-next-change] and (setq extent (list (overlay-start (car p)) (overlay-end (car p)))) (setq p (cdr p)) - (setq y (append 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. @@ -1027,9 +1031,8 @@ This is called when `global-highlight-changes-mode' is turned on." ;; (defun hilit-chg-debug-show (&optional beg end) ;; (interactive) ;; (message "--- hilit-chg-debug-show ---") -;; (hilit-chg-map-changes '(lambda (prop start end) -;; (message "%d-%d: %s" start end prop) -;; ) +;; (hilit-chg-map-changes (lambda (prop start end) +;; (message "%d-%d: %s" start end prop)) ;; beg end ;; )) ;; @@ -1037,5 +1040,4 @@ This is called when `global-highlight-changes-mode' is turned on." (provide 'hilit-chg) -;; arch-tag: de00301d-5bad-44da-aa82-e0e010b0c463 ;;; hilit-chg.el ends here