11:31 p.m.
Would this be a good addition to XEmacs? By Jim Hourihan <jimh(a)panix.com>
Jari
;;; cvs-conflict.el --- Minor mode for editing cvs conflicts
;; Copyright (C) 2000 Jim Hourihan
;; Author: Jim Hourihan <jimh(a)panix.com>
;; Created: 2000-11-01
;; Version: 1.3
;; Keywords: tools
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; 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.
;;; Commentary:
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Introduction
;; ------------
;;
;; This package helps you edit files with cvs conflict tags.
;;
;; To use insert in these lines into your ~/.emacs:
;;
;; (require 'cvs-conflict)
;; (add-hook 'find-file-hooks 'cvs-conflict-detect)
;;
;; cvs-conflict minor mode will be activated automatically if it
;; detects the presence of cvs conflict tags in the buffer. It will
;; automatically deactivate itself if the buffer is saved and no more
;; tags are detected.
;;
;; cvs-conflict was tested with GNU Emacs 20.5 and greater
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; History:
;;; Code:
(eval-when-compile (require 'cl))
(require 'easymenu)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:
;;; Interface to the command system
(defvar cvs-conflict-mode nil
"Minor mode cvs-conflict indicator.")
(make-variable-buffer-local 'cvs-conflict-mode)
(defvar cvs-conflict-mode-easymenu nil
"Keymap containing the menu for mode.")
(defgroup cvs-conflict nil
"Resolve cvs conflicts in a file"
:group 'tools)
(defcustom cvs-conflict-current-face 'cvs-conflict-current-face
"*Symbol face used to highlight conflicting text in current file."
:type 'face
:group 'cvs-conflict)
(defcustom cvs-conflict-update-face 'cvs-conflict-update-face
"*Symbol face used to highlight conflicting text from update."
:type 'face
:group 'cvs-conflict)
(defcustom cvs-conflict-separater-face 'cvs-conflict-separater-face
"*Symbol face used to highlight conflicting text from update."
:type 'face
:group 'cvs-conflict)
(defface cvs-conflict-current-face '((t (:background "PaleGreen")))
"Face used to highlight conflicting text in current file.")
(defface cvs-conflict-update-face '((t (:background "Wheat")))
"Face used to highlight conflicting text from update.")
(defface cvs-conflict-separater-face '((t (:background "Grey")))
"Face used to highlight conflicting text separaters.")
(defcustom cvs-conflict-verbose t
"*Verbose messages. Non-nil means generate messages."
:type 'boolean
:group 'cvs-conflict)
(defcustom cvs-conflict-invisible-separator nil
"*Select visible or invisible separator."
:type 'boolean
:group 'cvs-conflict)
(defcustom cvs-conflict-invisible-version-names nil
"*Non-nil means make file name/version invisible."
:type 'boolean
:group 'cvs-conflict)
(defcustom cvs-conflict-mode-name-string " Cvs!" ;; Short name for modeline
"*The minor mode string displayed when mode is on."
:type 'string
:group 'cvs-conflict)
(defcustom cvs-conflict-mode-menu-string "Cvs" ;; Short name for menubar too
"*The minor mode menu-bar string displayed when mode is on."
:type 'string
:group 'cvs-conflict)
(defcustom cvs-conflict-separator-regex "^=======$"
"*Regexp for separataor of conflict region."
:type 'regexp
:group 'cvs-conflict)
(defcustom cvs-conflict-begin-regex "^<<<<<<< "
"*Regexp for beginning of conflict region."
:type 'regexp
:group 'cvs-conflict)
(defcustom cvs-conflict-end-regex "^>>>>>>> "
"*Regexp for end of conflict region."
:type 'regexp
:group 'cvs-conflict)
(defcustom cvs-conflict-load-hook nil
"*Hook run whan file is loaded."
:type 'hook
:group 'cvs-conflict)
(defcustom cvs-conflict-load-hook nil
"*Hook run when file is loaded."
:type 'hook
:group 'cvs-conflict)
(defcustom cvs-conflict-mode-hook nil
"*Hook run when `cvs-conflict-mode' is called.
Check variable `cvs-conflict-mode'. as needed."
:type 'hook
:group 'cvs-conflict)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization
;;;###autoload
(defun cvs-conflict-customize ()
"Customize cvs-conflict group."
(interactive)
(customize-group 'cvs-conflict))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User commands
;;;###autoload
(defun cvs-conflict-mode (&optional arg)
"Toggle minor mode to aid in cvs source conflict editing.
With ARG, turn cvs-conflict mode on if ARG is positive, off
otherwise.
Installed keys:
\\{cvs-conflict-mode-map}."
(interactive "P")
(if (if arg
(> (prefix-numeric-value arg) 0)
(not cvs-conflict-mode))
(turn-on-cvs-conflict-mode)
(turn-off-cvs-conflict-mode)))
;;;###autoload
(defun turn-on-cvs-conflict-mode ()
"Turn on cvs-conflict-mode."
(interactive)
(setq cvs-conflict-mode t)
(cvs-conflict-highlight-buffer)
(if cvs-conflict-mode-easymenu
(easy-menu-add cvs-conflict-mode-easymenu))
(message "cvs-conflict minor mode is on")
(run-hooks 'cvs-conflict-mode-hook))
;;;###autoload
(defun turn-off-cvs-conflict-mode ()
"Turn off cvs-conflict-mode."
(interactive)
(setq cvs-conflict-mode nil)
(cvs-conflict-remove-overlays)
(if cvs-conflict-mode-easymenu
(easy-menu-remove cvs-conflict-mode-easymenu))
(message "cvs-conflict minor mode is off")
(run-hooks 'cvs-conflict-mode-hook))
(defun cvs-conflict-next-conflict ()
"Find the next conflict region.
Return position on success nil on failure."
(interactive)
(end-of-line)
(if (re-search-forward cvs-conflict-separator-regex nil t)
(progn (beginning-of-line) (point))
(beginning-of-line)
nil))
(defun cvs-conflict-previous-conflict ()
"Find the previous conflict region.
Return position on success nil on failure."
(interactive)
(beginning-of-line)
(if (re-search-backward cvs-conflict-separator-regex nil t)
(progn (beginning-of-line) (point))
(beginning-of-line)
nil))
(defun cvs-conflict-beginning-of-conflict ()
"Move to the beginning of conflict region.
Return position on success nil on failure."
(interactive)
(while (looking-at "<")
(forward-char))
(while (looking-at " ")
(forward-char))
(if (re-search-backward cvs-conflict-begin-regex nil t)
(progn (beginning-of-line) (point))
(beginning-of-line)
nil))
(defun cvs-conflict-end-of-conflict ()
"Move to the end of conflict region.
Return position on success nil on failure"
(interactive)
(if (re-search-forward cvs-conflict-end-regex nil t)
(progn (beginning-of-line) (point))
(beginning-of-line)
nil))
(defun cvs-conflict-kill-separators ()
"Remove merge separators in current conflicts."
(interactive)
(save-excursion
(cvs-conflict-beginning-of-conflict)
(kill-line 1)
(while (not (looking-at cvs-conflict-separator-regex)) (forward-line))
(kill-line 1)
(while (not (looking-at cvs-conflict-end-regex)) (forward-line))
(kill-line 1)))
(defun cvs-conflict-reject-other-version ()
"Remove merge separators in current conflicts.
Reject other version."
(interactive)
(save-excursion
(cvs-conflict-beginning-of-conflict)
(kill-line 1)
(while (not (looking-at cvs-conflict-separator-regex)) (forward-line))
(kill-line 1)
(while (not (looking-at cvs-conflict-end-regex)) (kill-line 1))
(kill-line 1)))
(defun cvs-conflict-accept-other-version ()
"Remove merge separators in current conflicts.
Accept other version."
(interactive)
(save-excursion
(cvs-conflict-beginning-of-conflict)
(kill-line 1)
(while (not (looking-at cvs-conflict-separator-regex)) (kill-line 1))
(kill-line 1)
(while (not (looking-at cvs-conflict-end-regex)) (forward-line))
(kill-line 1)))
(defun cvs-conflict-kill ()
"Remove merge separators and all conflicting text."
(interactive)
(save-excursion
(cvs-conflict-beginning-of-conflict)
(while (not (looking-at cvs-conflict-end-regex)) (kill-line 1))
(kill-line 1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions
(defun cvs-conflict-in-buffer-p ()
"Detect if a buffer contains any CVS conflict regions."
(save-excursion
(beginning-of-buffer)
(if (cvs-conflict-next-conflict)
(if (cvs-conflict-beginning-of-conflict)
(if (cvs-conflict-end-of-conflict) t)))))
(defun cvs-conflict-remove-overlays ()
"Remove all overlays in buffer."
(interactive)
(let ((overlays (overlays-in (point-min) (point-max))))
(while overlays
(if (memq (overlay-get (first overlays) 'face)
'(cvs-conflict-separater-face
cvs-conflict-current-face
cvs-conflict-update-face))
(delete-overlay (first overlays)))
(setq overlays (rest overlays)))))
(defun cvs-conflict-highlight-line (highlight-face &optional invis)
"Highlight line with given HIGHLIGHT-FACE optionally INVIS."
(let ((overlay (make-overlay (line-beginning-position)
(1+ (line-end-position)))))
(overlay-put overlay 'hilit t)
(overlay-put overlay 'invisible invis)
(overlay-put overlay 'face highlight-face)
(overlay-put overlay 'priority 0)))
(defun cvs-conflict-highlight-buffer ()
"Highlight conflicts."
(interactive)
(save-excursion
(cvs-conflict-remove-overlays)
(let ((count 0))
(beginning-of-buffer)
(while (cvs-conflict-next-conflict)
(setq count (1+ count))
;; highlight the separator
(cvs-conflict-highlight-line 'cvs-conflict-separater-face
cvs-conflict-invisible-separator)
(if (cvs-conflict-end-of-conflict)
(cvs-conflict-highlight-line 'cvs-conflict-separater-face
cvs-conflict-invisible-version-names))
(if (cvs-conflict-beginning-of-conflict)
(cvs-conflict-highlight-line 'cvs-conflict-separater-face
cvs-conflict-invisible-version-names))
(forward-line)
(while (not (looking-at cvs-conflict-separator-regex))
(cvs-conflict-highlight-line 'cvs-conflict-current-face)
(forward-line))
(forward-line)
(while (not (looking-at cvs-conflict-end-regex))
(cvs-conflict-highlight-line 'cvs-conflict-update-face)
(forward-line)))
;(message "%d conflicts" count)
)))
(defun cvs-conflict-detect ()
(if (cvs-conflict-in-buffer-p)
(turn-on-cvs-conflict-mode)
(if (eq cvs-conflict-mode t)
(turn-off-cvs-conflict-mode))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cvs-conflict-mode-map ()
"Return keymap for `cvs-conflict-mode'."
(let ((map (make-sparse-keymap)))
(define-key map "\C-cn" 'cvs-conflict-next-conflict)
(define-key map "\C-cp" 'cvs-conflict-previous-conflict)
(define-key map "\C-ca" 'cvs-conflict-beginning-of-conflict)
(define-key map "\C-ce" 'cvs-conflict-end-of-conflict)
(define-key map "\C-cr" 'cvs-conflict-reject-other-version)
(define-key map "\C-co" 'cvs-conflict-accept-other-version)
(define-key map "\C-cl" 'cvs-conflict-highlight-buffer)
(define-key map "\C-ck" 'cvs-conflict-kill-separators)
(define-key map "\C-c\d" 'cvs-conflict-kill)
;; And some Window-system fast keys.
(define-key map [(control backsapce)] 'cvs-conflict-kill)
(define-key map [(control delete)] 'cvs-conflict-kill)
map))
(defvar cvs-conflict-mode-map (cvs-conflict-mode-map)
"*Keymap of `cvs-conflict-mode'.
Installed keys:
\\{cvs-conflict-mode-map}.")
(defun cvs-conflict-mode-menu ()
"Return menu for `cvs-conflict-mode'."
(list
cvs-conflict-mode-menu-string
["Next" cvs-conflict-next-conflict t]
["Previous" cvs-conflict-previous-conflict t]
["Beginning" cvs-conflict-beginning-of-conflict t]
["End" cvs-conflict-end-of-conflict t]
"----"
["Reject Other Version" cvs-conflict-reject-other-version t]
["Use Other Version" cvs-conflict-accept-other-version t]
["Kill Separators" cvs-conflict-kill-separators t]
["Kill Conflict" cvs-conflict-kill t]
"----"
["Update" cvs-conflict-highlight-buffer t]
["Turn Off" turn-off-cvs-conflict-mode t]
))
(defun cvs-conflict-mode-define ()
"Define `cvs-conflict-mode'."
(if (or (boundp 'xemacs-logo)
(featurep 'xemacs))
;; Don't know why, but easy-menu-do-define works in XEmacs,
;; but easy-menu-define deos not.
(easy-menu-do-define 'cvs-conflict-mode-easymenu
nil
"Cvs Conflict"
(cvs-conflict-mode-menu))
(easy-menu-define 'cvs-conflict-mode-easymenu
cvs-conflict-mode-map
"Cvs Conflict"
(cvs-conflict-mode-menu))))
(defun cvs-conflict-mode-install (&optional uninstall)
"Install or UNINSTALL minor mode `cvs-conflict-mode'."
;; Uninstall is automatic / i.e re-install
(setq minor-mode-map-alist
(delete (assq 'cvs-conflict-mode minor-mode-map-alist)
minor-mode-map-alist))
(setq minor-mode-alist
(delete (assq 'cvs-conflict-mode minor-mode-alist)
minor-mode-alist))
(unless uninstall
(cvs-conflict-mode-define)
;; Do not install multiple copies, use pushnew with :test
(pushnew '(cvs-conflict-mode cvs-conflict-mode-name-string)
minor-mode-alist
:test 'equal)
(pushnew (cons 'cvs-conflict-mode cvs-conflict-mode-map)
minor-mode-map-alist
:test 'equal)))
(cvs-conflict-mode-install)
(provide 'cvs-conflict)
(run-hooks 'cvs-conflict-load-hook)
;;; cvs-conflict.el ends here