lisp/ediff-vers.el

   1 ;;; ediff-vers.el --- version control interface to Ediff
   2
   3 ;;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Kifer <kifer@cs.sunysb.edu>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24
  25 ;;; Code:
  26
  27 ;; Compiler pacifier
  28 (defvar rcs-default-co-switches)
  29 (defvar sc-mode)
  30 (defvar cvs-shell)
  31 (defvar cvs-program)
  32 (defvar cvs-cookie-handle)
  33 (defvar ediff-temp-file-prefix)
  34
  35 (and noninteractive
  36      (eval-when-compile
  37        (load "pcl-cvs" 'noerror)
  38        (load "rcs" 'noerror)
  39        ;; On 8+3 MS-DOS filesystems, generic-x.el is loaded
  40        ;; instead of (the missing) generic-sc.el.  Since the
  41        ;; version of Emacs which supports MS-DOS doesn't have
  42        ;; generic-sc, we simply avoid loading it.
  43        (or (and (fboundp 'msdos-long-file-names)
  44                 (not (msdos-long-file-names)))
  45            (load "generic-sc" 'noerror))
  46        (load "vc" 'noerror)))
  47 ;; end pacifier
  48
  49 ;; VC.el support
  50 (defun ediff-vc-internal (rev1 rev2 &optional startup-hooks)
  51 ;; Run Ediff on versions of the current buffer.
  52 ;; If REV2 is "" then compare current buffer with REV1.
  53 ;; If the current buffer is named `F', the version is named `F.~REV~'.
  54 ;; If `F.~REV~' already exists, it is used instead of being re-created.
  55   (let (file1 file2 rev1buf rev2buf)
  56     (save-window-excursion
  57       (save-excursion
  58         (vc-version-other-window rev1)
  59         (setq rev1buf (current-buffer)
  60               file1 (buffer-file-name)))
  61       (save-excursion
  62         (or (string= rev2 "")           ; use current buffer
  63             (vc-version-other-window rev2))
  64         (setq rev2buf (current-buffer)
  65               file2 (buffer-file-name)))
  66       (setq startup-hooks
  67             (cons `(lambda ()
  68                      (delete-file ,file1)
  69                      (or ,(string= rev2 "") (delete-file ,file2)))
  70                   startup-hooks)))
  71     (ediff-buffers
  72      rev1buf rev2buf
  73      startup-hooks
  74      'ediff-revision)))
  75
  76 ;; RCS.el support
  77 (defun rcs-ediff-view-revision (&optional rev)
  78 ;; View previous RCS revision of current file.
  79 ;; With prefix argument, prompts for a revision name.
  80   (interactive (list (if current-prefix-arg
  81                          (read-string "Revision: "))))
  82   (let* ((filename (buffer-file-name (current-buffer)))
  83          (switches (append '("-p")
  84                            (if rev (list (concat "-r" rev)) nil)))
  85          (buff (concat (file-name-nondirectory filename) ".~" rev "~")))
  86     (message "Working ...")
  87     (setq filename (expand-file-name filename))
  88     (with-output-to-temp-buffer buff
  89       (ediff-with-current-buffer standard-output
  90         (fundamental-mode))
  91       (let ((output-buffer (ediff-rcs-get-output-buffer filename buff)))
  92         (delete-windows-on output-buffer)
  93         (save-excursion
  94           (set-buffer output-buffer)
  95           (apply 'call-process "co" nil t nil
  96                  ;; -q: quiet (no diagnostics)
  97                  (append switches rcs-default-co-switches
  98                          (list "-q" filename)))))
  99       (message "")
 100       buff)))
 101
 102 (defun ediff-rcs-get-output-buffer (file name)
 103   ;; Get a buffer for RCS output for FILE, make it writable and clean it up.
 104   ;; Optional NAME is name to use instead of `*RCS-output*'.
 105   ;; This is a modified version from rcs.el v1.1.  I use it here to make
 106   ;; Ediff immune to changes in rcs.el
 107   (let* ((default-major-mode 'fundamental-mode) ; no frills!
 108          (buf (get-buffer-create name)))
 109     (save-excursion
 110       (set-buffer buf)
 111       (setq buffer-read-only nil
 112             default-directory (file-name-directory (expand-file-name file)))
 113       (erase-buffer))
 114     buf))
 115
 116 (defun ediff-rcs-internal (rev1 rev2 &optional startup-hooks)
 117 ;; Run Ediff on versions of the current buffer.
 118 ;; If REV2 is "" then use current buffer.
 119   (let (rev2buf rev1buf)
 120     (save-window-excursion
 121       (setq rev2buf (if (string= rev2 "")
 122                         (current-buffer)
 123                       (rcs-ediff-view-revision rev2))
 124             rev1buf (rcs-ediff-view-revision rev1)))
 125
 126     ;; rcs.el doesn't create temp version files, so we don't have to delete
 127     ;; anything in startup hooks to ediff-buffers
 128     (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)
 129     ))
 130
 131
 132 ;; GENERIC-SC.el support
 133
 134 (defun generic-sc-get-latest-rev ()
 135   (cond ((eq sc-mode 'CCASE)
 136          (eval "main/LATEST"))
 137         (t (eval ""))))
 138
 139 (defun ediff-generic-sc-internal (rev1 rev2 &optional startup-hooks)
 140 ;; Run Ediff on versions of the current buffer.
 141 ;; If REV2 is "" then compare current buffer with REV1.
 142 ;; If the current buffer is named `F', the version is named `F.~REV~'.
 143 ;; If `F.~REV~' already exists, it is used instead of being re-created.
 144   (let (rev1buf rev2buf)
 145     (save-excursion
 146       (if (or (not rev1) (string= rev1 ""))
 147           (setq rev1 (generic-sc-get-latest-rev)))
 148       (sc-visit-previous-revision rev1)
 149       (setq rev1buf (current-buffer)))
 150     (save-excursion
 151       (or (string= rev2 "")             ; use current buffer
 152           (sc-visit-previous-revision rev2))
 153       (setq rev2buf (current-buffer)))
 154     (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)))
 155
 156
 157 ;;; Merge with Version Control
 158
 159 (defun ediff-vc-merge-internal (rev1 rev2 ancestor-rev
 160                                      &optional startup-hooks merge-buffer-file)
 161 ;; If ANCESTOR-REV non-nil, merge with ancestor
 162   (let (buf1 buf2 ancestor-buf)
 163     (save-window-excursion
 164       (save-excursion
 165         (vc-version-other-window rev1)
 166         (setq buf1 (current-buffer)))
 167       (save-excursion
 168         (or (string= rev2 "")
 169             (vc-version-other-window rev2))
 170         (setq buf2 (current-buffer)))
 171       (if ancestor-rev
 172           (save-excursion
 173             (if (string= ancestor-rev "")
 174                 (setq ancestor-rev (vc-workfile-version buffer-file-name)))
 175             (vc-version-other-window ancestor-rev)
 176             (setq ancestor-buf (current-buffer))))
 177       (setq startup-hooks
 178             (cons
 179              `(lambda ()
 180                 (delete-file ,(buffer-file-name buf1))
 181                 (or ,(string= rev2 "")
 182                     (delete-file ,(buffer-file-name buf2)))
 183                 (or ,(string= ancestor-rev "")
 184                     ,(not ancestor-rev)
 185                     (delete-file ,(buffer-file-name ancestor-buf)))
 186                 )
 187              startup-hooks)))
 188     (if ancestor-rev
 189         (ediff-merge-buffers-with-ancestor
 190          buf1 buf2 ancestor-buf
 191          startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
 192       (ediff-merge-buffers
 193        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))
 194     ))
 195
 196 (defun ediff-rcs-merge-internal (rev1 rev2 ancestor-rev
 197                                       &optional
 198                                       startup-hooks merge-buffer-file)
 199   ;; If ANCESTOR-REV non-nil, merge with ancestor
 200   (let (buf1 buf2 ancestor-buf)
 201     (save-window-excursion
 202       (setq buf1 (rcs-ediff-view-revision rev1)
 203             buf2 (if (string= rev2 "")
 204                      (current-buffer)
 205                    (rcs-ediff-view-revision rev2))
 206             ancestor-buf (if ancestor-rev
 207                              (if (string= ancestor-rev "")
 208                                  (current-buffer)
 209                                (rcs-ediff-view-revision ancestor-rev)))))
 210     ;; rcs.el doesn't create temp version files, so we don't have to delete
 211     ;; anything in startup hooks to ediff-buffers
 212     (if ancestor-rev
 213         (ediff-merge-buffers-with-ancestor
 214          buf1 buf2 ancestor-buf
 215          startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
 216       (ediff-merge-buffers
 217        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))))
 218
 219 (defun ediff-generic-sc-merge-internal (rev1 rev2 ancestor-rev
 220                                              &optional
 221                                              startup-hooks merge-buffer-file)
 222   ;; If ANCESTOR-REV non-nil, merge with ancestor
 223   (let (buf1 buf2 ancestor-buf)
 224     (save-excursion
 225       (if (string= rev1 "")
 226           (setq rev1 (generic-sc-get-latest-rev)))
 227       (sc-visit-previous-revision rev1)
 228       (setq buf1 (current-buffer)))
 229     (save-excursion
 230       (or (string= rev2 "")
 231           (sc-visit-previous-revision rev2))
 232       (setq buf2 (current-buffer)))
 233     (if ancestor-rev
 234         (save-excursion
 235           (or (string= ancestor-rev "")
 236               (sc-visit-previous-revision ancestor-rev))
 237           (setq ancestor-buf (current-buffer))))
 238     (if ancestor-rev
 239         (ediff-merge-buffers-with-ancestor
 240          buf1 buf2 ancestor-buf
 241          startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file)
 242       (ediff-merge-buffers
 243        buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file))))
 244
 245
 246 ;; PCL-CVS.el support
 247
 248
 249 (defun cvs-run-ediff-on-file-descriptor (tin)
 250 ;; This is a replacement for cvs-emerge-mode
 251 ;; Runs after cvs-update.
 252 ;; Ediff-merge appropriate revisions of the selected file.
 253   (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
 254          (type (cvs-fileinfo->type fileinfo))
 255          (tmp-file
 256           (cvs-retrieve-revision-to-tmpfile fileinfo))
 257          (default-directory
 258            (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
 259          ancestor-file)
 260
 261     (or (memq type '(MERGED CONFLICT MODIFIED))
 262         (error
 263          "Can only merge `Modified', `Merged' or `Conflict' files"))
 264
 265     (cond ((memq type '(MERGED CONFLICT))
 266            (setq ancestor-file
 267                  (cvs-retrieve-revision-to-tmpfile
 268                   fileinfo
 269                   ;; revision
 270                   (cvs-fileinfo->base-revision fileinfo)))
 271            (ediff-merge-buffers-with-ancestor
 272             (find-file-noselect tmp-file)
 273             (find-file-noselect (cvs-fileinfo->backup-file fileinfo))
 274             (find-file-noselect ancestor-file)
 275             nil ; startup-hooks
 276             'ediff-merge-revisions-with-ancestor))
 277           ((eq type 'MODIFIED)
 278            (ediff-buffers
 279             (find-file-noselect tmp-file)
 280             (find-file-noselect (cvs-fileinfo->full-path fileinfo))
 281             nil ; startup-hooks
 282             'ediff-revisions)))
 283     (if (stringp tmp-file) (delete-file tmp-file))
 284     (if (stringp ancestor-file) (delete-file ancestor-file))))
 285
 286 ;;; Local Variables:
 287 ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
 288 ;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
 289 ;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
 290 ;;; End:
 291
 292 (provide 'ediff-vers)
 293
 294 ;;; ediff-vers.el ends here