X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/79ccae1e456a328c0877b3fd59be1c5748105c99..85249e52dc52fe130b2a1aee29a88c1165c1b5b1:/lisp/hilit-chg.el diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 081a627f3f..d6408412c0 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -1,6 +1,7 @@ ;;; hilit-chg.el --- minor mode displaying buffer changes with special face -;; Copyright (C) 1998, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Richard Sharman ;; Keywords: faces @@ -19,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -36,10 +37,10 @@ ;; Highlight Changes mode in passive state while you make your changes, toggle ;; it on to active mode to see them, then toggle it back off to avoid ;; distraction. -;; -;; When active, changes are displayed in `highlight-changes-face'. When -;; text is deleted, the following character is displayed in -;; `highlight-changes-delete-face' face. +;; +;; When active, changes are displayed in the `highlight-changes' face. +;; When text is deleted, the following character is displayed in the +;; `highlight-changes-delete' face. ;; ;; ;; You can "age" different sets of changes by using @@ -48,10 +49,10 @@ ;; changes. You can customize these "rotated" faces in two ways. You can ;; either explicitly define each face by customizing ;; `highlight-changes-face-list'. If, however, the faces differ from -;; `highlight-changes-face' only in the foreground color, you can simply set -;; `highlight-changes-colours'. If `highlight-changes-face-list' is nil when +;; the `highlight-changes' face only in the foreground color, you can simply set +;; `highlight-changes-colors'. If `highlight-changes-face-list' is nil when ;; the faces are required they will be constructed from -;; `highlight-changes-colours'. +;; `highlight-changes-colors'. ;; ;; ;; When a Highlight Changes mode is on (either active or passive) you can go @@ -61,7 +62,8 @@ ;; ;; You can also use the command highlight-compare-with-file to show changes ;; in this file compared with another file (typically the previous version -;; of the file). +;; of the file). The command highlight-compare-buffers can be used to +;; compare two buffers. ;; ;; ;; There are currently three hooks run by `highlight-changes-mode': @@ -75,18 +77,18 @@ ;; modes. The variable ;; `highlight-changes-mode' contains the new ;; state (`active' or `passive'.) -;; ;; -;; +;; +;; ;; Example usage: ;; (defun my-highlight-changes-enable-hook () -;; (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces) +;; (add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t) ;; ) -;; +;; ;; (defun my-highlight-changes-disable-hook () -;; (remove-hook 'local-write-file-hooks 'highlight-changes-rotate-faces) +;; (remove-hook 'write-file-functions 'highlight-changes-rotate-faces t) ;; ) -;; +;; ;; (add-hook 'highlight-changes-enable-hook 'my-highlight-changes-enable-hook) ;; (add-hook 'highlight-changes-disable-hook ;; 'my-highlight-changes-disable-hook) @@ -99,40 +101,40 @@ ;; ;; If you prefer to have it automatically invoked you can do it as ;; follows. -;; +;; ;; 1. Most modes have a major-hook, typically called MODE-hook. You -;; can use `add-hook' to call `highlight-changes-mode'. +;; can use `add-hook' to call `highlight-changes-mode'. ;; ;; Example: ;; (add-hook 'c-mode-hook 'highlight-changes-mode) ;; ;; If you want to make it start up in passive mode (regardless of the ;; setting of highlight-changes-initial-state): -;; (add-hook 'emacs-lisp-mode-hook +;; (add-hook 'emacs-lisp-mode-hook ;; (lambda () ;; (highlight-changes-mode 'passive))) ;; ;; However, this cannot be done for Fundamental mode for there is no ;; such hook. ;; -;; 2. You can use the function `global-highlight-changes' +;; 2. You can use the function `global-highlight-changes' ;; ;; This function, which is fashioned after the way `global-font-lock' works, ;; toggles on or off global Highlight Changes mode. When activated, it turns ;; on Highlight Changes mode in all "suitable" existing buffers and will turn ;; it on in new "suitable" buffers to be created. -;; +;; ;; A buffer's "suitability" is determined by variable -;; `highlight-changes-global-modes', as follows. If the variable is +;; `highlight-changes-global-modes', as follows. If the variable is ;; * nil -- then no buffers are suitable; ;; * a function -- this function is called and the result is used. As -;; an example, if the value is `buffer-file-name' then all buffers +;; an example, if the value is `buffer-file-name' then all buffers ;; who are visiting files are suitable, but others (like dired ;; buffers) are not; ;; * a list -- then the buffer is suitable iff its mode is in the -;; list, except if the first element is `not', in which case the test +;; list, except if the first element is `not', in which case the test ;; is reversed (i.e. it is a list of unsuitable modes). -;; * Otherwise, the buffer is suitable if its name does not begin with +;; * Otherwise, the buffer is suitable if its name does not begin with ;; ` ' or `*' and if `buffer-file-name' returns true. ;; @@ -147,8 +149,9 @@ ;; highlight-changes-remove-highlight ;; highlight-changes-rotate-faces ;; highlight-compare-with-file +;; highlight-compare-buffers -;; +;; ;; You can automatically rotate faces when the buffer is saved; ;; see function `highlight-changes-rotate-faces' for how to do this. ;; @@ -157,11 +160,11 @@ ;;; Bugs: ;; - the next-change and previous-change functions are too literal; -;; they should find the next "real" change, in other words treat +;; they should find the next "real" change, in other words treat ;; consecutive changes as one. -;;; To do (maybe), notes, ... +;;; To do (maybe), notes, ... ;; - having different faces for deletion and non-deletion: is it ;; really worth the hassle? @@ -174,10 +177,10 @@ ;;; History: -;; R Sharman (rsharman@magma.ca) Feb 1998: +;; R Sharman (rsharman@pobox.com) Feb 1998: ;; - initial release as change-mode. ;; Jari Aalto Mar 1998 -;; - fixes for byte compile errors +;; - fixes for byte compile errors ;; - use eval-and-compile for autoload ;; Marijn Ros Mar 98 ;; - suggested turning it on by default @@ -187,7 +190,9 @@ ;; - Changed to use overlays ;; August 98 ;; - renamed to Highlight Changes mode. - +;; Dec 2003 +;; - Use require for ediff stuff +;; - Added highlight-compare-buffers ;;; Code: @@ -208,56 +213,65 @@ ;; However, having it set for non-delete changes can be annoying because all ;; indentation on inserts gets underlined (which can look pretty ugly!). -(defface highlight-changes-face - '((((class color)) (:foreground "red" )) +(defface highlight-changes + '((((min-colors 88) (class color)) (:foreground "red1")) + (((class color)) (:foreground "red" )) (t (:inverse-video t))) "Face used for highlighting changes." :group 'highlight-changes) +;; backward-compatibility alias +(put 'highlight-changes-face 'face-alias 'highlight-changes) ;; This looks pretty ugly, actually. Maybe the underline should be removed. -(defface highlight-changes-delete-face - '((((class color)) (:foreground "red" :underline t)) +(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) +;; backward-compatibility alias +(put 'highlight-changes-delete-face 'face-alias 'highlight-changes-delete) -;; A (not very good) default list of colours to rotate through. +;; A (not very good) default list of colors to rotate through. ;; -(defcustom highlight-changes-colours +(defcustom highlight-changes-colors (if (eq (frame-parameter nil 'background-mode) 'light) ;; defaults for light background: '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue") ;; defaults for dark background: '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid")) - "*Colours used by `highlight-changes-rotate-faces'. -The newest rotated change will be displayed in the first element of this list, + "*Colors used by `highlight-changes-rotate-faces'. +The newest rotated change will be displayed in the first element of this list, the next older will be in the second element etc. -This list is used if `highlight-changes-face-list' is nil, otherwise that -variable overrides this list. If you only care about foreground -colours then use this, if you want fancier faces then set +This list is used if `highlight-changes-face-list' is nil, otherwise that +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) - -;; If you invoke highlight-changes-mode with no argument, should it start in +(define-obsolete-variable-alias 'highlight-changes-colours + 'highlight-changes-colors "22.1") + + +;; If you invoke highlight-changes-mode with no argument, should it start in ;; active or passive mode? ;; (defcustom highlight-changes-initial-state 'active - "*What state (active or passive) `highlight-changes' should start in. -This is used when `highlight-changes' is called with no argument. + "*What state (active or passive) Highlight Changes mode should start in. +This is used when `highlight-changes-mode' is called with no argument. This variable must be set to one of the symbols `active' or `passive'." :type '(choice (const :tag "Active" active) (const :tag "Passive" passive)) :group 'highlight-changes) (defcustom highlight-changes-global-initial-state 'passive - "*What state `global-highlight-changes' should start in. + "*What state global Highlight Changes mode should start in. This is used if `global-highlight-changes' is called with no argument. -This variable must be set to either `active' or `passive'" +This variable must be set to either `active' or `passive'." :type '(choice (const :tag "Active" active) (const :tag "Passive" passive)) :group 'highlight-changes) @@ -265,7 +279,7 @@ This variable must be set to either `active' or `passive'" ;; The strings displayed in the mode-line for the minor mode: (defcustom highlight-changes-active-string " +Chg" "*The string used when Highlight Changes mode is in the active state. -This should be set to nil if no indication is desired, or to +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)) @@ -273,7 +287,7 @@ a string with a leading space." (defcustom highlight-changes-passive-string " -Chg" "*The string used when Highlight Changes mode is in the passive state. -This should be set to nil if no indication is desired, or to +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)) @@ -289,17 +303,17 @@ A list means the elements are major modes suitable for Highlight Changes mode, or a list whose first element is `not' followed by major modes which are not suitable. -t means the buffer is suitable if it is visiting a file and its name -does not begin with ` ' or `*'. +A value of t means the buffer is suitable if it is visiting a file and +its name does not begin with ` ' or `*'. A value of nil means no buffers are suitable for `global-highlight-changes' \(effectively disabling the mode). -Examples: +Example: (c-mode c++-mode) means that Highlight Changes mode is turned on for buffers in C and C++ modes only." - :type '(choice + :type '(choice (const :tag "all non-special buffers visiting files" t) (set :menu-tag "specific modes" :tag "modes" :value (not) @@ -325,8 +339,8 @@ remove it from existing buffers." (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 + ;; 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 ;; actually done by copying the faces so user-defined faces still remain ;; in the same order. ;; The notifying the parent is needed because without it changes to the @@ -341,18 +355,18 @@ remove it from existing buffers." ) (while p (setq old-name (car p)) - (setq new-name (intern (format "highlight-changes-face-%d" n))) + (setq new-name (intern (format "highlight-changes-%d" n))) (if (eq old-name new-name) nil ;; A new face has been inserted: we don't want to modify the - ;; default face so copy it. Better, though, (I think) is to + ;; default face so copy it. Better, though, (I think) is to ;; make a new face have the same attributes as - ;; highlight-changes-face . + ;; the `highlight-changes' face. (if (eq old-name 'default) - (copy-face 'highlight-changes-face new-name) + (copy-face 'highlight-changes new-name) (copy-face old-name new-name) )) - (setq new-list (append (list new-name) new-list)) + (setq new-list (append (list new-name) new-list)) (setq n (1- n)) (setq p (cdr p))) (if (equal new-list (widget-value w)) @@ -371,16 +385,16 @@ remove it from existing buffers." (defcustom highlight-changes-face-list nil "*A list of faces used when rotating changes. Normally the variable is initialized to nil and the list is created from -`highlight-changes-colours' when needed. However, you can set this variable +`highlight-changes-colors' when needed. However, you can set this variable to any list of faces. You will have to do this if you want faces which -don't just differ from `highlight-changes-face' by the foreground colour. +don't just differ from the `highlight-changes' face by the foreground color. Otherwise, this list will be constructed when needed from -`highlight-changes-colours'." +`highlight-changes-colors'." :type '(choice - (repeat + (repeat :notify hilit-chg-cust-fix-changes-face-list face ) - (const :tag "Derive from highlight-changes-colours" nil) + (const :tag "Derive from highlight-changes-colors" nil) ) :group 'highlight-changes) @@ -388,8 +402,6 @@ Otherwise, this list will be constructed when needed from ;; These shouldn't be changed! -;; Autoload for the benefit of `make-mode-line-mouse-sensitive'. -;;;###autoload (defvar highlight-changes-mode nil) (defvar hilit-chg-list nil) (defvar hilit-chg-string " ??") @@ -401,22 +413,13 @@ Otherwise, this list will be constructed when needed from (make-variable-buffer-local 'hilit-chg-string) - -(eval-and-compile - ;; For highlight-compare-with-file - (defvar ediff-number-of-differences) - (autoload 'ediff-setup "ediff") - (autoload 'ediff-with-current-buffer "ediff") - (autoload 'ediff-really-quit "ediff") - (autoload 'ediff-make-fine-diffs "ediff") - (autoload 'ediff-get-fine-diff-vector "ediff") - (autoload 'ediff-get-difference "ediff")) - +(require 'ediff-init) +(require 'ediff-util) ;;; Functions... -(defun hilit-chg-map-changes (func &optional start-position end-position) +(defun hilit-chg-map-changes (func &optional start-position end-position) "Call function FUNC for each region used by Highlight Changes mode." ;; if start-position is nil, (point-min) is used ;; if end-position is nil, (point-max) is used @@ -450,11 +453,11 @@ This is the opposite of `hilit-chg-hide-changes'." (let ((ov (make-overlay start end)) face) (if (eq prop 'hilit-chg-delete) - (setq face 'highlight-changes-delete-face) + (setq face 'highlight-changes-delete) (setq face (nth 1 (member prop hilit-chg-list)))) (if face (progn - ;; We must mark the face, that is the purpose of the overlay + ;; We must mark the face, that is the purpose of the overlay (overlay-put ov 'face face) ;; I don't think we need to set evaporate since we should ;; be controlling them! @@ -468,7 +471,7 @@ This is the opposite of `hilit-chg-hide-changes'." (defun hilit-chg-hide-changes (&optional beg end) "Remove face information for Highlight Changes mode. -The overlay containing the face is removed, but the text property +The overlay containing the face is removed, but the text property containing the change information is retained. This is the opposite of `hilit-chg-display-changes'." @@ -486,7 +489,7 @@ This is the opposite of `hilit-chg-display-changes'." "Fix change overlays in region between BEG and END. Ensure the overlays agree with the changes as determined from -the text properties of type `hilit-chg' ." +the text properties of type `hilit-chg'." ;; Remove or alter overlays in region beg..end (let (ov-start ov-end props q) ;; temp for debugging: @@ -513,15 +516,15 @@ the text properties of type `hilit-chg' ." (hilit-chg-display-changes beg end))) ;;;###autoload -(defun highlight-changes-remove-highlight (beg end) - "Remove the change face from the region between BEG and END. +(defun highlight-changes-remove-highlight (beg end) + "Remove the change face from the region between BEG and END. This allows you to manually remove highlighting from uninteresting changes." (interactive "r") (let ((after-change-functions nil)) - (remove-text-properties beg end '(hilit-chg nil)) + (remove-text-properties beg end '(hilit-chg nil)) (hilit-chg-fixup beg end))) -(defun hilit-chg-set-face-on-change (beg end leng-before +(defun hilit-chg-set-face-on-change (beg end leng-before &optional no-property-change) "Record changes and optionally display them in a distinctive face. `hilit-chg-set' adds this function to the `after-change-functions' hook." @@ -532,7 +535,7 @@ This allows you to manually remove highlighting from uninteresting changes." ;; ;; We do NOT want to simply do this if this is an undo command, because ;; otherwise an undone change shows up as changed. While the properties - ;; are automatically restored by undo, we must fix up the overlay. + ;; are automatically restored by undo, we must fix up the overlay. (save-match-data (let ((beg-decr 1) (end-incr 1) (type 'hilit-chg) @@ -544,9 +547,9 @@ This allows you to manually remove highlighting from uninteresting changes." ;; 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 + ;; 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) @@ -557,10 +560,10 @@ This allows you to manually remove highlighting from uninteresting changes." (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 + ;; 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 + ;; 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 @@ -601,14 +604,14 @@ This removes all saved change information." (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t) (let ((after-change-functions nil)) (hilit-chg-hide-changes) - (hilit-chg-map-changes + (hilit-chg-map-changes '(lambda (prop start stop) (remove-text-properties start stop '(hilit-chg nil)))) ) (setq highlight-changes-mode nil) (force-mode-line-update) ;; If we type: C-u -1 M-x highlight-changes-mode - ;; we want to turn it off, but hilit-chg-post-command-hook + ;; we want to turn it off, but hilit-chg-post-command-hook ;; runs and that turns it back on! (remove-hook 'post-command-hook 'hilit-chg-post-command-hook))) @@ -616,7 +619,7 @@ This removes all saved change information." (defun highlight-changes-mode (&optional arg) "Toggle (or initially set) Highlight Changes mode. -Without an argument: +Without an argument: If Highlight Changes mode is not enabled, then enable it (in either active or passive state as determined by the variable `highlight-changes-initial-state'); otherwise, toggle between active @@ -633,18 +636,18 @@ Passive state - means changes are kept and new ones recorded but are Functions: \\[highlight-changes-next-change] - move point to beginning of next change -\\[highlight-changes-previous-change] - move to beginning of previous change +\\[highlight-changes-previous-change] - move to beginning of previous change \\[highlight-compare-with-file] - mark text as changed by comparing this buffer with the contents of a file \\[highlight-changes-remove-highlight] - remove the change face from the region \\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes \ -through - various faces. +through + various faces Hook variables: -`highlight-changes-enable-hook' - when enabling Highlight Changes mode. +`highlight-changes-enable-hook' - when enabling Highlight Changes mode `highlight-changes-toggle-hook' - when entering active or passive state -`highlight-changes-disable-hook' - when turning off Highlight Changes mode." +`highlight-changes-disable-hook' - when turning off Highlight Changes mode" (interactive "P") (if (or (display-color-p) (and (fboundp 'x-display-grayscale-p) (x-display-grayscale-p))) @@ -659,7 +662,7 @@ Hook variables: ;; an argument is given ((eq arg 'active) 'active) - ((eq arg 'passive) + ((eq arg 'passive) 'passive) ((> (prefix-numeric-value arg) 0) 'active) @@ -726,30 +729,30 @@ Hook variables: (defun hilit-chg-make-list (&optional force) "Construct `hilit-chg-list' and `highlight-changes-face-list'." - ;; Constructs highlight-changes-face-list if necessary, + ;; Constructs highlight-changes-face-list if necessary, ;; and hilit-chg-list always: ;; Maybe this should always be called when rotating a face ;; so we pick up any changes? (if (or (null highlight-changes-face-list) ; Don't do it if it force) ; already exists unless FORCE non-nil. - (let ((p highlight-changes-colours) + (let ((p highlight-changes-colors) (n 1) name) (setq highlight-changes-face-list nil) (while p - (setq name (intern (format "highlight-changes-face-%d" n))) - (copy-face 'highlight-changes-face name) + (setq name (intern (format "highlight-changes-%d" n))) + (copy-face 'highlight-changes name) (set-face-foreground name (car p)) - (setq highlight-changes-face-list + (setq highlight-changes-face-list (append highlight-changes-face-list (list name))) (setq p (cdr p)) (setq n (1+ n))))) - (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face)) + (setq hilit-chg-list (list 'hilit-chg 'highlight-changes)) (let ((p highlight-changes-face-list) - (n 1) + (n 1) last-category last-face) (while p (setq last-category (intern (format "change-%d" n))) - ;; (setq last-face (intern (format "highlight-changes-face-%d" n))) + ;; (setq last-face (intern (format "highlight-changes-%d" n))) (setq last-face (car p)) (setq hilit-chg-list (append hilit-chg-list @@ -779,11 +782,11 @@ of `highlight-changes-face-list', one level older changes are shown in face described by the second element, and so on. Very old changes remain shown in the last face in the list. -You can automatically rotate colours when the buffer is saved -by adding the following to `local-write-file-hooks', by evaling it in the -buffer to be saved): +You can automatically rotate colors when the buffer is saved by adding +this function to `write-file-functions' as a buffer-local value. To do +this, eval the following in the buffer to be saved: - \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)" + \(add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t)" (interactive) ;; If not in active mode do nothing but don't complain because this ;; may be bound to a hook. @@ -798,21 +801,112 @@ buffer to be saved): ;; and display them all if active (if (eq highlight-changes-mode 'active) (hilit-chg-display-changes)))) - ;; This always returns nil so it is safe to use in - ;; local-write-file-hook + ;; This always returns nil so it is safe to use in write-file-functions nil) ;; ======================================================================== -;; Comparing with an existing file. -;; This uses ediff to find the differences. +;; Comparing buffers/files +;; These use ediff to find the differences. + +(defun highlight-markup-buffers + (buf-a file-a buf-b file-b &optional markup-a-only) + "Get differences between two buffers and set highlight changes. +Both buffers are done unless optional parameter MARKUP-A-ONLY +is non-nil." + (save-window-excursion + (let* (change-info + change-a change-b + a-start a-end len-a + b-start b-end len-b + (bufa-modified (buffer-modified-p buf-a)) + (bufb-modified (buffer-modified-p buf-b)) + (buf-a-read-only (with-current-buffer buf-a buffer-read-only)) + (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)) + (with-current-buffer buf-a + (save-buffer) + (setq bufa-modified (buffer-modified-p buf-a))) + (setq file-a nil))) + (or file-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)) + (with-current-buffer buf-b + (save-buffer) + (setq bufb-modified (buffer-modified-p buf-b))) + (setq file-b nil))) + (or file-b + (setq temp-b (setq file-b (ediff-make-temp-file buf-b nil)))) + (set-buffer buf-a) + (highlight-changes-mode 'active) + (or markup-a-only (with-current-buffer buf-b + (highlight-changes-mode 'active))) + (setq change-info (hilit-chg-get-diff-info buf-a file-a buf-b file-b)) + + + (setq change-a (car change-info)) + (setq change-b (car (cdr change-info))) + + (hilit-chg-make-list) + (while change-a + (setq a-start (nth 0 (car change-a))) + (setq a-end (nth 1 (car change-a))) + (setq b-start (nth 0 (car change-b))) + (setq b-end (nth 1 (car change-b))) + (setq len-a (- a-end a-start)) + (setq len-b (- b-end b-start)) + (set-buffer buf-a) + (hilit-chg-set-face-on-change a-start a-end len-b buf-a-read-only) + (or markup-a-only + (with-current-buffer buf-b + (hilit-chg-set-face-on-change b-start b-end len-a + buf-b-read-only) + )) + (setq change-a (cdr change-a)) + (setq change-b (cdr change-b))) + (or bufa-modified + (with-current-buffer buf-a (set-buffer-modified-p nil))) + (or bufb-modified + (with-current-buffer buf-b (set-buffer-modified-p nil))) + (if temp-a + (delete-file temp-a)) + (if temp-b + (delete-file temp-b))) + )) + +;;;###autoload +(defun highlight-compare-buffers (buf-a buf-b) +"Compare two buffers and highlight the differences. + +The default is the current buffer and the one in the next window. + +If either buffer is modified and is visiting a file, you are prompted +to save the file. + +Unless the buffer is unmodified and visiting a file, the buffer is +written to a temporary file for comparison. + +If a buffer is read-only, differences will be highlighted but no property +changes are made, so \\[highlight-changes-next-change] and +\\[highlight-changes-previous-change] will not work." + (interactive + (list + (get-buffer (read-buffer "buffer-a " (current-buffer) t)) + (get-buffer + (read-buffer "buffer-b " + (window-buffer (next-window (selected-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) + )) ;;;###autoload (defun highlight-compare-with-file (file-b) "Compare this buffer with a file, and highlight differences. -The current buffer must be an unmodified buffer visiting a file, -and must not be read-only. - If the buffer has a backup filename, it is used as the default when this function is called interactively. @@ -829,64 +923,24 @@ changes are made, so \\[highlight-changes-next-change] and "" ;; directory nil ;; default 'yes ;; must exist - (let ((f (make-backup-file-name - (or (buffer-file-name (current-buffer)) - (error "no file for this buffer"))))) - (if (file-exists-p f) f ""))))) - + (let ((f (buffer-file-name (current-buffer)))) + (if f + (progn + (setq f (make-backup-file-name f)) + (or (file-exists-p f) + (setq f nil))) + ) + f)))) (let* ((buf-a (current-buffer)) - (buf-a-read-only buffer-read-only) - (orig-pos (point)) (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)) - xy xx yy p q - a-start a-end len-a - b-start b-end len-b) - - ;; We use the fact that the buffer is not marked modified at the - ;; end where we clear its modified status - (if (buffer-modified-p buf-a) - (if (y-or-n-p (format "OK to save %s? " file-a)) - (save-buffer buf-a) - (error "Buffer must be saved before comparing with a file"))) - (if (and existing-buf (buffer-modified-p buf-b)) - (if (y-or-n-p (format "OK to save %s? " file-b)) - (save-buffer buf-b) - (error "Cannot compare with a file in an unsaved buffer"))) - (highlight-changes-mode 'active) - (if existing-buf (with-current-buffer buf-b - (highlight-changes-mode 'active))) - (save-window-excursion - (setq xy (hilit-chg-get-diff-info buf-a file-a buf-b file-b))) - (setq xx (car xy)) - (setq p xx) - (setq yy (car (cdr xy))) - (setq q yy) - (hilit-chg-make-list) - (while p - (setq a-start (nth 0 (car p))) - (setq a-end (nth 1 (car p))) - (setq b-start (nth 0 (car q))) - (setq b-end (nth 1 (car q))) - (setq len-a (- a-end a-start)) - (setq len-b (- b-end b-start)) - (set-buffer buf-a) - (hilit-chg-set-face-on-change a-start a-end len-b buf-a-read-only) - (set-buffer-modified-p nil) - (goto-char orig-pos) - (if existing-buf - (with-current-buffer buf-b - (hilit-chg-set-face-on-change b-start b-end len-a - buf-b-read-only ) - )) - (setq p (cdr p)) - (setq q (cdr q))) - (if existing-buf - (set-buffer-modified-p nil) - (kill-buffer buf-b)))) + (buf-b-read-only (with-current-buffer buf-b buffer-read-only))) + (highlight-markup-buffers buf-a file-a buf-b file-b (not existing-buf)) + (unless existing-buf + (kill-buffer buf-b)) + )) (defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b) @@ -901,20 +955,20 @@ changes are made, so \\[highlight-changes-next-change] and (defun hilit-chg-get-diff-list-hk () - ;; x and y are dynamically bound by hilit-chg-get-diff-info + ;; 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)) + (setq 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 x nil y nil) ;; x and y are bound by hilit-chg-get-diff-info (while (< n ediff-number-of-differences) (ediff-make-fine-diffs n) (setq va (ediff-get-fine-diff-vector n 'A)) ;; va is a vector if there are fine differences (if va (setq a (append va nil)) - ;; if not, get the unrefined difference + ;; if not, get the unrefined difference (setq va (ediff-get-difference n 'A)) (setq a (list (elt va 0)))) ;; a list a list @@ -929,7 +983,7 @@ changes are made, so \\[highlight-changes-next-change] and ;; vb is a vector (if vb (setq b (append vb nil)) - ;; if not, get the unrefined difference + ;; if not, get the unrefined difference (setq vb (ediff-get-difference n 'B)) (setq b (list (elt vb 0)))) ;; b list a list @@ -948,16 +1002,16 @@ changes are made, so \\[highlight-changes-next-change] and ;; Global Highlight Changes mode is modeled after Global Font-lock mode. ;; Three hooks are used to gain control. When Global Changes Mode is -;; enabled, `find-file-hooks' and `change-major-mode-hook' are set. -;; `find-file-hooks' is called when visiting a file, the new mode is +;; enabled, `find-file-hook' and `change-major-mode-hook' are set. +;; `find-file-hook' is called when visiting a file, the new mode is ;; known at this time. ;; `change-major-mode-hook' is called when a buffer is changing mode. ;; This could be because of finding a file in which case -;; `find-file-hooks' has already been called and has done its work. +;; `find-file-hook' has already been called and has done its work. ;; However, it also catches the case where a new mode is being set by ;; the user. However, it is called from `kill-all-variables' and at -;; this time the mode is the old mode, which is not what we want. -;; So, our function temporarily sets `post-command-hook' which will +;; this time the mode is the old mode, which is not what we want. +;; So, our function temporarily sets `post-command-hook' which will ;; be called after the buffer has been completely set up (with the new ;; mode). It then removes the `post-command-hook'. ;; One other wrinkle - every M-x command runs the `change-major-mode-hook' @@ -969,14 +1023,14 @@ changes are made, so \\[highlight-changes-next-change] and (defun hilit-chg-post-command-hook () ;; This is called after changing a major mode, but also after each - ;; M-x command, in which case the current buffer is a minibuffer. - ;; In that case, do not act on it here, but don't turn it off - ;; either, we will get called here again soon-after. - ;; Also, don't enable it for other special buffers. + ;; M-x command, in which case the current buffer is a minibuffer. + ;; In that case, do not act on it here, but don't turn it off + ;; either, we will get called here again soon-after. + ;; Also, don't enable it for other special buffers. (if (string-match "^[ *]" (buffer-name)) nil ;; (message "ignoring this post-command-hook") (remove-hook 'post-command-hook 'hilit-chg-post-command-hook) - ;; The following check isn't necessary, since + ;; The following check isn't necessary, since ;; hilit-chg-turn-on-maybe makes this check too. (or highlight-changes-mode ;; don't turn it on if it already is (hilit-chg-turn-on-maybe highlight-changes-global-initial-state)))) @@ -993,21 +1047,21 @@ changes are made, so \\[highlight-changes-next-change] and When called interactively: - if no prefix, toggle global Highlight Changes mode on or off - if called with a positive prefix (or just C-u) turn it on in active mode -- if called with a zero prefix turn it on in passive mode +- if called with a zero prefix turn it on in passive mode - if called with a negative prefix turn it off When called from a program: - if ARG is nil or omitted, turn it off -- if ARG is `active', turn it on in active mode +- if ARG is `active', turn it on in active mode - if ARG is `passive', turn it on in passive mode -- otherwise just turn it on +- otherwise just turn it on When global Highlight Changes mode is enabled, Highlight Changes mode is turned on for future \"suitable\" buffers (and for \"suitable\" existing buffers if variable `highlight-changes-global-changes-existing-buffers' is non-nil). \"Suitability\" is determined by variable `highlight-changes-global-modes'." - (interactive + (interactive (list (cond ((null current-prefix-arg) @@ -1023,30 +1077,30 @@ variable `highlight-changes-global-changes-existing-buffers' is non-nil). 'passive) ;; negative interactive arg - turn it off (t - (setq global-highlight-changes nil) + (setq global-highlight-changes nil) nil)))) (if arg (progn (if (eq arg 'active) (setq highlight-changes-global-initial-state 'active) - (if (eq arg 'passive) + (if (eq arg 'passive) (setq highlight-changes-global-initial-state 'passive))) (setq global-highlight-changes t) (message "Turning ON Global Highlight Changes mode in %s state" highlight-changes-global-initial-state) - (add-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook) - (add-hook 'find-file-hooks 'hilit-chg-check-global) + ;; FIXME: Not sure what this was intended to do. --Stef + ;; (add-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook) + (add-hook 'find-file-hook 'hilit-chg-check-global) (if highlight-changes-global-changes-existing-buffers - (hilit-chg-update-all-buffers + (hilit-chg-update-all-buffers highlight-changes-global-initial-state))) - + (message "Turning OFF global Highlight Changes mode") - (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook) - (remove-hook 'find-file-hooks 'hilit-chg-check-global) - (remove-hook 'post-command-hook - 'hilit-chg-post-command-hook) - (remove-hook 'find-file-hooks 'hilit-chg-check-global) + ;; FIXME: Not sure what this was intended to do. --Stef + ;; (remove-hook 'hilit-chg-major-mode-hook 'hilit-chg-major-mode-hook) + (remove-hook 'post-command-hook 'hilit-chg-post-command-hook) + (remove-hook 'find-file-hook 'hilit-chg-check-global) (if highlight-changes-global-changes-existing-buffers (hilit-chg-update-all-buffers nil)))) @@ -1055,13 +1109,13 @@ variable `highlight-changes-global-changes-existing-buffers' is non-nil). "Turn on Highlight Changes mode if it is appropriate for this buffer. A buffer is appropriate for Highlight Changes mode if all these are true: -- the buffer is not a special buffer (one whose name begins with - `*' or ` ') +- the buffer is not a special buffer (one whose name begins with + `*' or ` '), - the buffer's mode is suitable as per variable - `highlight-changes-global-modes' + `highlight-changes-global-modes', - Highlight Changes mode is not already on for this buffer. -This function is called from `hilit-chg-update-all-buffers' or +This function is called from `hilit-chg-update-all-buffers' or from `global-highlight-changes' when turning on global Highlight Changes mode." (or highlight-changes-mode ; do nothing if already on (if @@ -1075,13 +1129,13 @@ from `global-highlight-changes' when turning on global Highlight Changes mode." (not (memq major-mode (cdr highlight-changes-global-modes))) (memq major-mode highlight-changes-global-modes))) (t - (and - (not (string-match "^[ *]" (buffer-name))) + (and + (not (string-match "^[ *]" (buffer-name))) (buffer-file-name)))) (progn (hilit-chg-set value) (run-hooks 'highlight-changes-enable-hook))))) - + (defun hilit-chg-turn-off-maybe () (if highlight-changes-mode @@ -1091,14 +1145,27 @@ from `global-highlight-changes' when turning on global Highlight Changes mode." (defun hilit-chg-update-all-buffers (value) - (mapcar + (mapc (function (lambda (buffer) (with-current-buffer buffer (if value (hilit-chg-turn-on-maybe value) (hilit-chg-turn-off-maybe)) ))) - (buffer-list))) + (buffer-list)) + nil) + +;;;; Desktop support. + +;; Called by `desktop-create-buffer' to restore `highlight-changes-mode'. +(defun hilit-chg-desktop-restore (desktop-buffer-locals) + (highlight-changes-mode + (or (cdr (assq 'highlight-changes-mode desktop-buffer-locals)) 1))) + +(add-to-list 'desktop-minor-mode-handlers + '(highlight-changes-mode . hilit-chg-desktop-restore)) + +(add-to-list 'desktop-locals-to-save 'highlight-changes-mode) ;; ===================== debug ================== ;; For debug & test use: @@ -1111,9 +1178,10 @@ from `global-highlight-changes' when turning on global Highlight Changes mode." ;; ) ;; beg end ;; )) -;; +;; ;; ================== end of debug =============== (provide 'hilit-chg) +;; arch-tag: de00301d-5bad-44da-aa82-e0e010b0c463 ;;; hilit-chg.el ends here