/[emacs]/emacs/lisp/hilit-chg.el
ViewVC logotype

Diff of /emacs/lisp/hilit-chg.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21 by pj, Mon Apr 22 15:27:08 2002 UTC revision 1.22 by lektu, Fri Sep 6 07:15:11 2002 UTC
# Line 38  Line 38 
38  ;; distraction.  ;; distraction.
39  ;;  ;;
40  ;; When active, changes are displayed in `highlight-changes-face'.  When  ;; When active, changes are displayed in `highlight-changes-face'.  When
41  ;; text is deleted,  the following character is displayed in  ;; text is deleted, the following character is displayed in
42  ;; `highlight-changes-delete-face' face.  ;; `highlight-changes-delete-face' face.
43  ;;  ;;
44  ;;  ;;
# Line 123  Line 123 
123  ;; it on in new "suitable" buffers to be created.  ;; it on in new "suitable" buffers to be created.
124  ;;  ;;
125  ;; A buffer's "suitability" is determined by variable  ;; A buffer's "suitability" is determined by variable
126  ;; `highlight-changes-global-modes',  as follows.  If the variable is  ;; `highlight-changes-global-modes', as follows.  If the variable is
127  ;; * nil  -- then no buffers are suitable;  ;; * nil  -- then no buffers are suitable;
128  ;; * a function -- this function is called and the result is used.  As  ;; * a function -- this function is called and the result is used.  As
129  ;;   an example,  if the value is `buffer-file-name' then all buffers  ;;   an example, if the value is `buffer-file-name' then all buffers
130  ;;   who are visiting files are suitable, but others (like dired  ;;   who are visiting files are suitable, but others (like dired
131  ;;   buffers) are not;  ;;   buffers) are not;
132  ;; * a list -- then the buffer is suitable iff its mode is in the  ;; * a list -- then the buffer is suitable iff its mode is in the
133  ;;   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
134  ;;   is reversed (i.e. it is a list of unsuitable modes).  ;;   is reversed (i.e. it is a list of unsuitable modes).
135  ;; * Otherwise,  the buffer is suitable if its name does not begin with  ;; * Otherwise, the buffer is suitable if its name does not begin with
136  ;;   ` ' or `*' and if `buffer-file-name' returns true.  ;;   ` ' or `*' and if `buffer-file-name' returns true.
137  ;;  ;;
138    
# Line 157  Line 157 
157  ;;; Bugs:  ;;; Bugs:
158    
159  ;; - the next-change and previous-change functions are too literal;  ;; - the next-change and previous-change functions are too literal;
160  ;;   they should find the next "real" change,  in other words treat  ;;   they should find the next "real" change, in other words treat
161  ;;   consecutive changes as one.  ;;   consecutive changes as one.
162    
163    
164  ;;; To do (maybe),  notes, ...  ;;; To do (maybe), notes, ...
165    
166  ;; - having different faces for deletion and non-deletion: is it  ;; - having different faces for deletion and non-deletion: is it
167  ;;   really worth the hassle?  ;;   really worth the hassle?
# Line 232  Line 232 
232        ;; defaults for dark background:        ;; defaults for dark background:
233      '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))      '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))
234    "*Colours used by `highlight-changes-rotate-faces'.    "*Colours used by `highlight-changes-rotate-faces'.
235  The newest rotated change will be displayed in the first element of this list,  The newest rotated change will be displayed in the first element of this list,
236  the next older will be in the second element etc.  the next older will be in the second element etc.
237    
238  This list is used if `highlight-changes-face-list' is nil,  otherwise that  This list is used if `highlight-changes-face-list' is nil, otherwise that
239  variable overrides this list.   If you only care about foreground  variable overrides this list.  If you only care about foreground
240  colours then use this,  if you want fancier faces then set  colours then use this, if you want fancier faces then set
241  `highlight-changes-face-list'."  `highlight-changes-face-list'."
242    :type '(repeat color)    :type '(repeat color)
243    :group 'highlight-changes)    :group 'highlight-changes)
244    
245    
246  ;; If you invoke highlight-changes-mode with no argument,  should it start in  ;; If you invoke highlight-changes-mode with no argument, should it start in
247  ;; active or passive mode?  ;; active or passive mode?
248  ;;  ;;
249  (defcustom highlight-changes-initial-state 'active  (defcustom highlight-changes-initial-state 'active
# Line 265  This variable must be set to either `act Line 265  This variable must be set to either `act
265  ;; The strings displayed in the mode-line for the minor mode:  ;; The strings displayed in the mode-line for the minor mode:
266  (defcustom highlight-changes-active-string " +Chg"  (defcustom highlight-changes-active-string " +Chg"
267    "*The string used when Highlight Changes mode is in the active state.    "*The string used when Highlight Changes mode is in the active state.
268  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
269  a string with a leading space."  a string with a leading space."
270    :type '(choice string    :type '(choice string
271                   (const :tag "None"  nil))                   (const :tag "None"  nil))
# Line 273  a string with a leading space." Line 273  a string with a leading space."
273    
274  (defcustom highlight-changes-passive-string " -Chg"  (defcustom highlight-changes-passive-string " -Chg"
275    "*The string used when Highlight Changes mode is in the passive state.    "*The string used when Highlight Changes mode is in the passive state.
276  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
277  a string with a leading space."  a string with a leading space."
278    :type '(choice string    :type '(choice string
279                   (const :tag "None"  nil))                   (const :tag "None"  nil))
# Line 325  remove it from existing buffers." Line 325  remove it from existing buffers."
325    
326  (defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)  (defun hilit-chg-cust-fix-changes-face-list (w wc &optional event)
327    ;; When customization function `highlight-changes-face-list' inserts a new    ;; When customization function `highlight-changes-face-list' inserts a new
328    ;; face it uses the default face.   We don't want the user to modify this    ;; face it uses the default face.  We don't want the user to modify this
329    ;; face,  so we rename the faces in the list on an insert.  The rename is    ;; face, so we rename the faces in the list on an insert.  The rename is
330    ;; actually done by copying the faces so user-defined faces still remain    ;; actually done by copying the faces so user-defined faces still remain
331    ;; in the same order.    ;; in the same order.
332    ;; The notifying the parent is needed because without it changes to the    ;; The notifying the parent is needed because without it changes to the
# Line 345  remove it from existing buffers." Line 345  remove it from existing buffers."
345              (if (eq old-name new-name)              (if (eq old-name new-name)
346                  nil                  nil
347                ;; A new face has been inserted: we don't want to modify the                ;; A new face has been inserted: we don't want to modify the
348                ;; default face so copy it.   Better, though, (I think) is to                ;; default face so copy it.  Better, though, (I think) is to
349                ;; make a new face have the same attributes as                ;; make a new face have the same attributes as
350                ;; highlight-changes-face .                ;; highlight-changes-face .
351                (if (eq old-name 'default)                (if (eq old-name 'default)
# Line 454  This is the opposite of `hilit-chg-hide- Line 454  This is the opposite of `hilit-chg-hide-
454        (setq face (nth 1 (member prop hilit-chg-list))))        (setq face (nth 1 (member prop hilit-chg-list))))
455      (if face      (if face
456          (progn          (progn
457            ;; We must mark the face,  that is the purpose of the overlay            ;; We must mark the face, that is the purpose of the overlay
458            (overlay-put ov 'face face)            (overlay-put ov 'face face)
459            ;; I don't think we need to set evaporate since we should            ;; I don't think we need to set evaporate since we should
460            ;; be controlling them!            ;; be controlling them!
# Line 468  This is the opposite of `hilit-chg-hide- Line 468  This is the opposite of `hilit-chg-hide-
468  (defun hilit-chg-hide-changes (&optional beg end)  (defun hilit-chg-hide-changes (&optional beg end)
469    "Remove face information for Highlight Changes mode.    "Remove face information for Highlight Changes mode.
470    
471  The overlay containing the face is removed,  but the text property  The overlay containing the face is removed, but the text property
472  containing the change information is retained.  containing the change information is retained.
473    
474  This is the opposite of `hilit-chg-display-changes'."  This is the opposite of `hilit-chg-display-changes'."
# Line 532  This allows you to manually remove highl Line 532  This allows you to manually remove highl
532    ;;    ;;
533    ;; We do NOT want to simply do this if this is an undo command, because    ;; We do NOT want to simply do this if this is an undo command, because
534    ;; otherwise an undone change shows up as changed.  While the properties    ;; otherwise an undone change shows up as changed.  While the properties
535    ;; are automatically restored by undo,  we must fix up the overlay.    ;; are automatically restored by undo, we must fix up the overlay.
536    (save-match-data    (save-match-data
537      (let ((beg-decr 1) (end-incr 1)      (let ((beg-decr 1) (end-incr 1)
538            (type 'hilit-chg)            (type 'hilit-chg)
# Line 545  This allows you to manually remove highl Line 545  This allows you to manually remove highl
545              (progn              (progn
546                ;; The eolp and bolp tests are a kludge!  But they prevent                ;; The eolp and bolp tests are a kludge!  But they prevent
547                ;; rather nasty looking displays when deleting text at the end                ;; rather nasty looking displays when deleting text at the end
548                ;; of line,  such as normal corrections as one is typing and                ;; of line, such as normal corrections as one is typing and
549                ;; immediately makes a correction,  and when deleting first                ;; immediately makes a correction, and when deleting first
550                ;; character of a line.                ;; character of a line.
551  ;;;           (if (= leng-before 1)  ;;;           (if (= leng-before 1)
552  ;;;               (if (eolp)  ;;;               (if (eolp)
# Line 557  This allows you to manually remove highl Line 557  This allows you to manually remove highl
557                (setq end (min (+ end end-incr) (point-max)))                (setq end (min (+ end end-incr) (point-max)))
558                (setq type 'hilit-chg-delete))                (setq type 'hilit-chg-delete))
559            ;; Not a deletion.            ;; Not a deletion.
560            ;; Most of the time the following is not necessary,  but            ;; Most of the time the following is not necessary, but
561            ;; if the current text was marked as a deletion then            ;; if the current text was marked as a deletion then
562            ;; the old overlay is still in effect, so if we add some            ;; the old overlay is still in effect, so if we add some
563            ;; text then remove the deletion marking,  but set it to            ;; text then remove the deletion marking, but set it to
564            ;; changed otherwise its highlighting disappears.            ;; changed otherwise its highlighting disappears.
565            (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)            (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
566                (progn                (progn
# Line 608  This removes all saved change informatio Line 608  This removes all saved change informatio
608      (setq highlight-changes-mode nil)      (setq highlight-changes-mode nil)
609      (force-mode-line-update)      (force-mode-line-update)
610      ;; If we type:  C-u -1 M-x highlight-changes-mode      ;; If we type:  C-u -1 M-x highlight-changes-mode
611      ;; we want to turn it off,  but hilit-chg-post-command-hook      ;; we want to turn it off, but hilit-chg-post-command-hook
612      ;; runs and that turns it back on!      ;; runs and that turns it back on!
613      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)))      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)))
614    
# Line 726  Hook variables: Line 726  Hook variables:
726    
727  (defun hilit-chg-make-list (&optional force)  (defun hilit-chg-make-list (&optional force)
728    "Construct `hilit-chg-list' and `highlight-changes-face-list'."    "Construct `hilit-chg-list' and `highlight-changes-face-list'."
729    ;; Constructs highlight-changes-face-list if necessary,      ;; Constructs highlight-changes-face-list if necessary,
730    ;; and hilit-chg-list always:    ;; and hilit-chg-list always:
731    ;; Maybe this should always be called when rotating a face    ;; Maybe this should always be called when rotating a face
732    ;; so we pick up any changes?    ;; so we pick up any changes?
# Line 780  face described by the second element, an Line 780  face described by the second element, an
780  shown in the last face in the list.  shown in the last face in the list.
781    
782  You can automatically rotate colours when the buffer is saved  You can automatically rotate colours when the buffer is saved
783  by adding the following to `local-write-file-hooks',  by evaling it in the  by adding the following to `local-write-file-hooks', by evaling it in the
784  buffer to be saved):  buffer to be saved):
785    
786    \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)"    \(add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)"
# Line 803  buffer to be saved): Line 803  buffer to be saved):
803    nil)    nil)
804    
805  ;; ========================================================================  ;; ========================================================================
806  ;; Comparing with an existing file.    ;; Comparing with an existing file.
807  ;; This uses ediff to find the differences.  ;; This uses ediff to find the differences.
808    
809  ;;;###autoload  ;;;###autoload
# Line 914  changes are made, so \\[highlight-change Line 914  changes are made, so \\[highlight-change
914        ;; va is a vector if there are fine differences        ;; va is a vector if there are fine differences
915        (if va        (if va
916            (setq a (append va nil))            (setq a (append va nil))
917          ;; if not,  get the unrefined difference          ;; if not, get the unrefined difference
918          (setq va (ediff-get-difference n 'A))          (setq va (ediff-get-difference n 'A))
919          (setq a (list (elt va 0))))          (setq a (list (elt va 0))))
920        ;; a list a list        ;; a list a list
# Line 929  changes are made, so \\[highlight-change Line 929  changes are made, so \\[highlight-change
929        ;; vb is a vector        ;; vb is a vector
930        (if vb        (if vb
931            (setq b (append vb nil))            (setq b (append vb nil))
932          ;; if not,  get the unrefined difference          ;; if not, get the unrefined difference
933          (setq vb (ediff-get-difference n 'B))          (setq vb (ediff-get-difference n 'B))
934          (setq b (list (elt vb 0))))          (setq b (list (elt vb 0))))
935        ;; b list a list        ;; b list a list
# Line 949  changes are made, so \\[highlight-change Line 949  changes are made, so \\[highlight-change
949  ;; Global Highlight Changes mode is modeled after Global Font-lock mode.  ;; Global Highlight Changes mode is modeled after Global Font-lock mode.
950  ;; Three hooks are used to gain control.  When Global Changes Mode is  ;; Three hooks are used to gain control.  When Global Changes Mode is
951  ;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.  ;; enabled, `find-file-hooks' and `change-major-mode-hook' are set.
952  ;; `find-file-hooks' is called when visiting a file,  the new mode is  ;; `find-file-hooks' is called when visiting a file, the new mode is
953  ;; known at this time.  ;; known at this time.
954  ;; `change-major-mode-hook' is called when a buffer is changing mode.  ;; `change-major-mode-hook' is called when a buffer is changing mode.
955  ;; This could be because of finding a file in which case  ;; This could be because of finding a file in which case
956  ;; `find-file-hooks' has already been called and has done its work.  ;; `find-file-hooks' has already been called and has done its work.
957  ;; However, it also catches the case where a new mode is being set by  ;; However, it also catches the case where a new mode is being set by
958  ;; the user.  However, it is called from `kill-all-variables' and at  ;; the user.  However, it is called from `kill-all-variables' and at
959  ;; this time the mode is the old mode,  which is not what we want.  ;; this time the mode is the old mode, which is not what we want.
960  ;; So,  our function temporarily sets `post-command-hook' which will  ;; So, our function temporarily sets `post-command-hook' which will
961  ;; be called after the buffer has been completely set up (with the new  ;; be called after the buffer has been completely set up (with the new
962  ;; mode).  It then removes the `post-command-hook'.  ;; mode).  It then removes the `post-command-hook'.
963  ;; One other wrinkle - every M-x command runs the `change-major-mode-hook'  ;; One other wrinkle - every M-x command runs the `change-major-mode-hook'
# Line 969  changes are made, so \\[highlight-change Line 969  changes are made, so \\[highlight-change
969    
970  (defun hilit-chg-post-command-hook ()  (defun hilit-chg-post-command-hook ()
971    ;; This is called after changing a major mode, but also after each    ;; This is called after changing a major mode, but also after each
972    ;; M-x command,  in which case the current buffer is a minibuffer.    ;; M-x command, in which case the current buffer is a minibuffer.
973    ;; In that case, do not act on it here,  but don't turn it off    ;; In that case, do not act on it here, but don't turn it off
974    ;; either,  we will get called here again soon-after.    ;; either, we will get called here again soon-after.
975    ;; Also,  don't enable it for other special buffers.    ;; Also, don't enable it for other special buffers.
976    (if (string-match "^[ *]"  (buffer-name))    (if (string-match "^[ *]"  (buffer-name))
977        nil ;; (message "ignoring this post-command-hook")        nil ;; (message "ignoring this post-command-hook")
978      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)      (remove-hook 'post-command-hook 'hilit-chg-post-command-hook)
979      ;; The following check isn't necessary,  since      ;; The following check isn't necessary, since
980      ;; hilit-chg-turn-on-maybe makes this check too.      ;; hilit-chg-turn-on-maybe makes this check too.
981      (or highlight-changes-mode  ;; don't turn it on if it already is      (or highlight-changes-mode  ;; don't turn it on if it already is
982          (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))))          (hilit-chg-turn-on-maybe highlight-changes-global-initial-state))))
# Line 998  When called interactively: Line 998  When called interactively:
998    
999  When called from a program:  When called from a program:
1000  - if ARG is nil or omitted, turn it off  - if ARG is nil or omitted, turn it off
1001  - if ARG is `active',  turn it on in active mode  - if ARG is `active', turn it on in active mode
1002  - if ARG is `passive', turn it on in passive mode  - if ARG is `passive', turn it on in passive mode
1003  - otherwise just turn it on  - otherwise just turn it on
1004    

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26