lisp/ediff-vers.el

   1 ;;; ediff-vers.el --- version control interface to Ediff
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 ;; Compiler pacifier
  30 (defvar rcs-default-co-switches)
  31
  32 (and noninteractive
  33      (eval-when-compile
  34        (condition-case nil
  35            ;; for compatibility with current stable version of xemacs
  36            (progn
  37              ;;(require 'pcvs nil 'noerror)
  38              ;;(require 'rcs nil 'noerror)
  39              (require 'pcvs)
  40              (require 'rcs))
  41          (error nil))
  42        (require 'vc)
  43        (require 'ediff-init)
  44        ))
  45 ;; end pacifier
  46
  47 (defcustom ediff-keep-tmp-versions nil
  48   "*If t, do not delete temporary previous versions for the files on which
  49 comparison or merge operations are being performed."
  50   :type 'boolean
  51   :group 'ediff-vers
  52   )
  53
  54 (defalias 'ediff-vc-revision-other-window
  55       (if (fboundp 'vc-revision-other-window)
  56           'vc-revision-other-window
  57         'vc-version-other-window))
  58
  59 (defalias 'ediff-vc-working-revision
  60   (if (fboundp 'vc-working-revision)
  61       'vc-working-revision
  62     'vc-workfile-version))
  63
  64 ;; VC.el support
  65
  66 (eval-when-compile
  67   (require 'vc-hooks)) ;; for vc-call macro
  68
  69
  70 (defun ediff-vc-latest-version (file)
  71   "Return the version level of the latest version of FILE in repository."
  72   (if (fboundp 'vc-latest-version)
  73       (vc-latest-version file)
  74     (or (vc-file-getprop file 'vc-latest-version)
  75         (cond ((vc-backend file)
  76                (vc-call state file)
  77                (vc-file-getprop file 'vc-latest-version))
  78               (t (error "File %s is not under version control" file))))
  79     ))
  80
  81
  82 (defun ediff-vc-internal (rev1 rev2 &optional startup-hooks)
  83   ;; Run Ediff on versions of the current buffer.
  84   ;; If REV1 is "", use the latest version of the current buffer's file.
  85   ;; If REV2 is "" then compare current buffer with REV1.
  86   ;; If the current buffer is named `F', the version is named `F.~REV~'.
  87   ;; If `F.~REV~' already exists, it is used instead of being re-created.
  88   (let (file1 file2 rev1buf rev2buf)
  89     (if (string= rev1 "")
  90         (setq rev1 (ediff-vc-latest-version (buffer-file-name))))
  91     (save-window-excursion
  92       (save-excursion
  93         (ediff-vc-revision-other-window rev1)
  94         (setq rev1buf (current-buffer)
  95               file1 (buffer-file-name)))
  96       (save-excursion
  97         (or (string= rev2 "")           ; use current buffer
  98             (ediff-vc-revision-other-window rev2))
  99         (setq rev2buf (current-buffer)
 100               file2 (buffer-file-name)))
 101       (setq startup-hooks
 102             (cons `(lambda ()
 103                      (ediff-delete-version-file ,file1)
 104                      (or ,(string= rev2 "") (ediff-delete-version-file ,file2)))
 105                   startup-hooks)))
 106     (ediff-buffers
 107      rev1buf rev2buf
 108      startup-hooks
 109      'ediff-revision)))
 110
 111 ;; RCS.el support
 112 (defun rcs-ediff-view-revision (&optional rev)
 113 ;; View previous RCS revision of current file.
 114 ;; With prefix argument, prompts for a revision name.
 115   (interactive (list (if current-prefix-arg
 116                          (read-string "Revision: "))))
 117   (let* ((filename (buffer-file-name (current-buffer)))
 118          (switches (append '("-p")
 119                            (if rev (list (concat "-r" rev)) nil)))
 120          (buff (concat (file-name-nondirectory filename) ".~" rev "~")))
 121     (message "Working ...")
 122     (setq filename (expand-file-name filename))
 123     (with-output-to-temp-buffer buff
 124       (ediff-with-current-buffer standard-output
 125         (fundamental-mode))
 126       (let ((output-buffer (ediff-rcs-get-output-buffer filename buff)))
 127         (delete-windows-on output-buffer)
 128         (save-excursion
 129           (set-buffer output-buffer)
 130           (apply 'call-process "co" nil t nil
 131                  ;; -q: quiet (no diagnostics)
 132                  (append switches rcs-default-co-switches
 133                          (list "-q" filename)))))
 134       (message "")
 135       buff)))
 136
 137 (defun ediff-rcs-get-output-buffer (file name)
 138   ;; Get a buffer for RCS output for FILE, make it writable and clean it up.
 139   ;; Optional NAME is name to use instead of `*RCS-output*'.
 140   ;; This is a modified version from rcs.el v1.1.  I use it here to make
 141   ;; Ediff immune to changes in rcs.el
 142   (let* ((default-major-mode 'fundamental-mode) ; no frills!
 143          (buf (get-buffer-create name)))
 144     (save-excursion
 145       (set-buffer buf)
 146       (setq buffer-read-only nil
 147             default-directory (file-name-directory (expand-file-name file)))
 148       (erase-buffer))
 149     buf))
 150
 151 (defun ediff-rcs-internal (rev1 rev2 &optional startup-hooks)
 152 ;; Run Ediff on versions of the current buffer.
 153 ;; If REV2 is "" then use current buffer.
 154   (let (rev2buf rev1buf)
 155     (save-window-excursion
 156       (setq rev2buf (if (string= rev2 "")
 157                         (current-buffer)
 158                       (rcs-ediff-view-revision rev2))
 159             rev1buf (rcs-ediff-view-revision rev1)))
 160
 161     ;; rcs.el doesn't create temp version files, so we don't have to delete
 162     ;; anything in startup hooks to ediff-buffers
 163     (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)
 164     ))
 165
 166 ;;; Merge with Version Control
 167
 168 (defun ediff-vc-merge-internal (rev1 rev2 ancestor-rev
 169                                      &optional startup-hooks merge-buffer-file)
 170 ;; If ANCESTOR-REV non-nil, merge with ancestor
 171   (let (buf1 buf2 ancestor-buf)
 172     (save-window-excursion
 173       (save-excursion
 174         (ediff-vc-revision-other-window rev1)
 175         (setq buf1 (current-buffer)))
 176       (save-excursion
 177         (or (string= rev2 "")
 178             (ediff-vc-revision-other-window rev2))
 179         (setq buf2 (current-buffer)))
 180       (if ancestor-rev
 181           (save-excursion
 182             (if (string= ancestor-rev "")
 183                 (setq ancestor-rev (ediff-vc-working-revision buffer-file-name)))
 184             (ediff-vc-revision-other-window ancestor-rev)
 185             (setq ancestor-buf (current-buffer))))
 186       (setq startup-hooks
 187             (cons
 188              `(lambda ()
 189                 (ediff-delete-version-file ,(buffer-file-name buf1))
 190                 (or ,(string= rev2 "")
 191                     (ediff-delete-version-file ,(buffer-file-name buf2)))
 192                 (or ,(string= ancestor-rev "")
 193                     ,(not ancestor-rev)
 194                     (ediff-delete-version-file ,(buffer-file-name ancestor-buf)))
 195                 )
 196              startup-hooks)))
 197     (if ancestor-rev
 198         (ediff-merge-buffers-with-ancestor
 199          buf1 buf2 ancestor-buf
 200          startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
 201       (ediff-merge-buffers
 202        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))
 203     ))
 204
 205 (defun ediff-rcs-merge-internal (rev1 rev2 ancestor-rev
 206                                       &optional
 207                                       startup-hooks merge-buffer-file)
 208   ;; If ANCESTOR-REV non-nil, merge with ancestor
 209   (let (buf1 buf2 ancestor-buf)
 210     (save-window-excursion
 211       (setq buf1 (rcs-ediff-view-revision rev1)
 212             buf2 (if (string= rev2 "")
 213                      (current-buffer)
 214                    (rcs-ediff-view-revision rev2))
 215             ancestor-buf (if ancestor-rev
 216                              (if (string= ancestor-rev "")
 217                                  (current-buffer)
 218                                (rcs-ediff-view-revision ancestor-rev)))))
 219     ;; rcs.el doesn't create temp version files, so we don't have to delete
 220     ;; anything in startup hooks to ediff-buffers
 221     (if ancestor-rev
 222         (ediff-merge-buffers-with-ancestor
 223          buf1 buf2 ancestor-buf
 224          startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
 225       (ediff-merge-buffers
 226        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))))
 227
 228
 229 ;; delete version file on exit unless ediff-keep-tmp-versions is true
 230 (defun ediff-delete-version-file (file)
 231   (or ediff-keep-tmp-versions (delete-file file)))
 232
 233
 234 (provide 'ediff-vers)
 235
 236
 237 ;;; Local Variables:
 238 ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
 239 ;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
 240 ;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
 241 ;;; End:
 242
 243 ;; arch-tag: bbb34f0c-2a90-426a-a77a-c75f479ebbbf
 244 ;;; ediff-vers.el ends here