cgit.sxemacs.org Git - packages/blob - xemacs-packages/dired/diff.el

   1 ;; -*-Emacs-Lisp-*-
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; File:         diff.el
   5 ;; Version:      #Revision: 4.0 $
   6 ;; Author:       This file is based on diff.el by
   7 ;;               sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
   8 ;;               It has been completely rewritten in July 1994 by
   9 ;;               Sandy Rutherford <sandy@ibm550.sissa.it>
  10 ;;               It has mostly been demolished in March 2001 by
  11 ;;               Mike Sperber <mike@xemacs.org> to use
  12 ;;               Stefan Monnier's diff-mode.
  13 ;; RCS:
  14 ;; Description:  Call unix diff utility.
  15 ;;
  16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17
  18 ;;; Copyright (C) 1990 Free Software Foundation, Inc.
  19 ;;; Copyright (C) 1994 Sandy Rutherford
  20 ;;; Copyright (C) 2001 Mike Sperber
  21
  22 ;;; This file is based on diff.el by sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
  23 ;;; It has been completely rewritten in July 1994 by
  24 ;;; Sandy Rutherford <sandy@ibm550.sissa.it>
  25 ;;; It has mostly been demolished in March 2001 by
  26 ;;; Mike Sperber <mike@xemacs.org> to use
  27
  28 ;;; This program is free software; you can redistribute it and/or modify
  29 ;;; it under the terms of the GNU General Public License as published by
  30 ;;; the Free Software Foundation; either version 1, or (at your option)
  31 ;;; any later version.
  32 ;;;
  33 ;;; This program is distributed in the hope that it will be useful,
  34 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  35 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36 ;;; GNU General Public License for more details.
  37 ;;;
  38 ;;; A copy of the GNU General Public License can be obtained from this
  39 ;;; program's author (send electronic mail to sandy@ibm550.sissa.it) or
  40 ;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
  41 ;;; MA 02139, USA.
  42
  43 (require 'custom)
  44 (require 'diff-mode)
  45
  46 (provide 'diff)
  47
  48 ;;; User Variables
  49
  50 (defgroup diff nil
  51   "Handling output from Unix diff utility"
  52   :group 'tools)
  53
  54 ;; should be in to loaddefs.el now.
  55 ;;;###autoload
  56 (defcustom diff-switches "-c"
  57   "*A list of switches (strings) to pass to the diff program."
  58   :type '(choice string
  59                  (repeat string))
  60   :group 'diff)
  61
  62 (defcustom diff-do-narrow nil
  63   "*If non-nil diff buffers are initialized narrowed to each difference."
  64   :type 'boolean
  65   :group 'diff)
  66
  67 (defcustom diff-load-hooks nil
  68   "Hooks to run after loading diff.el"
  69   :type 'hook
  70   :group 'diff)
  71
  72 ;;; Internal variables
  73
  74 (defconst diff-emacs-19-p
  75   (let ((ver emacs-major-version))
  76     (>= ver 19)))
  77
  78 (or diff-emacs-19-p (require 'emacs-19))
  79
  80 (defvar diff-old-file nil)
  81 ;; A list whose car is the name of the old file, and whose cdr indicates
  82 ;; whether we should delete the buffer on quit.
  83 (defvar diff-new-file nil)
  84 ;; Same as diff-old-file, except for the new file.
  85
  86 (defvar diff-temp-template (expand-file-name "diff" (temp-directory)))
  87
  88 (defun diff-read-args (oldprompt newprompt switchprompt
  89                                  &optional file-for-backup)
  90   ;; Grab the args for diff.  OLDPROMPT and NEWPROMPT are the prompts
  91   ;; for the old & new filenames, SWITCHPROMPT for the list of
  92   ;; switches.  If FILE_FOR_BACKUP is provided (it must be a string if
  93   ;; so), then it will be used to try & work out a file & backup to
  94   ;; diff, & in this case the prompting order is backwards.  %s in a
  95   ;; prompt has a guess substituted into it.  This is nasty.
  96   (let (oldf newf)
  97     (if file-for-backup
  98         (setq newf file-for-backup
  99               newf (if (and newf (file-exists-p newf))
 100                        (read-file-name
 101                         (format newprompt (file-name-nondirectory newf))
 102                         nil newf t)
 103                      (read-file-name (format newprompt "") nil nil t))
 104               oldf (file-newest-backup newf)
 105               oldf (if (and oldf (file-exists-p oldf))
 106                        (read-file-name
 107                         (format oldprompt (file-name-nondirectory oldf))
 108                         nil oldf t)
 109                      (read-file-name (format oldprompt "")
 110                                      (file-name-directory newf) nil t)))
 111       ;; Else we aren't trying to be bright...
 112       (setq oldf (read-file-name (format oldprompt "") nil nil t)
 113             newf (read-file-name
 114                   (format newprompt (file-name-nondirectory oldf))
 115                   nil (file-name-directory oldf) t)))
 116         (list oldf newf (diff-read-switches switchprompt))))
 117
 118 (defun diff-read-switches (switchprompt)
 119   ;; Read and return a list of switches
 120   (if current-prefix-arg
 121       (let ((default (if (listp diff-switches)
 122                          (mapconcat 'identity diff-switches " ")
 123                        diff-switches)))
 124         (diff-fix-switches
 125          (read-string (format switchprompt default) default)))))
 126
 127 (defun diff-fix-switches (switch-spec)
 128   ;; Parse a string into a list of switches or leave it be if it's
 129   ;; not a string
 130   (if (stringp switch-spec)
 131       (let (result (start 0))
 132         (while (string-match "\\(\\S-+\\)" switch-spec start)
 133           (setq result (cons (substring switch-spec (match-beginning 1)
 134                                         (match-end 1))
 135                              result)
 136                 start (match-end 0)))
 137         (nreverse result))
 138     switch-spec))
 139
 140 (defun diff-get-file-buffer (file)
 141   ;; Returns \(BUFFER . DEL-P\), where DEL-P is t if diff is expected
 142   ;; to delete the buffer, and nil otherwise.
 143   (let* ((buff (get-file-buffer file))
 144          (del-p (null buff)))
 145     (if (and buff (buffer-modified-p buff))
 146         (progn
 147           (message
 148            "Buffer %s is modified.  Diffing against buffer contents."
 149            (buffer-name buff))
 150           (sit-for 1)))
 151     ;; Call find-file-noselect even if we already have the buffer,
 152     ;; as it will run verify-buffer-file-modtime.
 153     (cons (find-file-noselect file) del-p)))
 154
 155 (defun diff-cleanup-buffers ()
 156   ;; Cleans up diff buffers by deleting buffers that we don't expect
 157   ;; the user to care about.
 158   (let ((files (list diff-old-file diff-new-file)))
 159     (while files
 160       (let ((ent (car files))
 161             buff)
 162         (and (cdr ent)
 163              (setq buff (get-file-buffer (car ent)))
 164              (not (buffer-modified-p buff))
 165              (kill-buffer buff)))
 166       (setq files (cdr files)))
 167     (if (get-buffer "*Diff Header*")
 168         (kill-buffer "*Diff Header*"))))
 169
 170 (defun diff-latest-backup-file (file)
 171   "Return the latest existing backup of FILE, or nil."
 172   ;; First try simple backup, then the highest numbered of the
 173   ;; numbered backups.
 174   ;; Ignore the value of version-control because we look for existing
 175   ;; backups, which maybe were made earlier or by another user with
 176   ;; a different value of version-control.
 177   (let* ((file (expand-file-name file))
 178          (handler (find-file-name-handler file 'diff-latest-backup-file)))
 179     (if handler
 180         (funcall handler 'diff-latest-backup-file file)
 181       (or
 182        (let ((bak (make-backup-file-name file)))
 183          (if (file-exists-p bak) bak))
 184        (let* ((dir (file-name-directory file))
 185               (base-versions (concat (file-name-nondirectory file) ".~"))
 186               (bv-length (length base-versions)))
 187          (concat dir
 188                  (car (sort
 189                        (file-name-all-completions base-versions dir)
 190                        ;; bv-length is a fluid var for backup-extract-version:
 191                        (function
 192                         (lambda (fn1 fn2)
 193                           (> (backup-extract-version fn1)
 194                              (backup-extract-version fn2))))))))))))
 195
 196 (defun diff-run-diff (switches old old-temp new new-temp)
 197   ;; Actually run the diff process with SWITCHES on OLD and NEW.
 198   ;; OLD-TEMP and NEW-TEMP are names of temp files that can be used
 199   ;; to dump the data out to.
 200   (insert "diff " (mapconcat 'identity switches " ") " " old
 201           " " new "\n")
 202   (apply 'call-process "diff" nil t nil
 203          (append switches (list old-temp new-temp))))
 204
 205
 206 (defun diff-fix-file-names (old old-temp new new-temp pattern)
 207   ;; Replaces any temp file names with the real names of files.
 208   (save-excursion
 209     (save-restriction
 210       (let ((files (list old new))
 211             (temps (list old-temp new-temp))
 212             buffer-read-only case-fold-search)
 213         (goto-char (point-min))
 214         (if (re-search-forward pattern nil t)
 215             (narrow-to-region (point-min) (match-beginning 0)))
 216         (while files
 217           (let ((regexp (concat "[ \t\n]\\("
 218                                 (regexp-quote (car temps))
 219                                 "\\)[ \t\n]")))
 220             (goto-char (point-min))
 221             (forward-line 1)
 222             (while (re-search-forward regexp nil t)
 223               (goto-char (match-beginning 1))
 224               (delete-region (point) (match-end 1))
 225               (insert (car files))))
 226           (setq files (cdr files)
 227                 temps (cdr temps)))))))
 228
 229 ;;;###autoload
 230 (defun diff (old new &optional switches)
 231   "Find and display the differences between OLD and NEW files.
 232 Interactively you are prompted with the current buffer's file name for NEW
 233 and what appears to be its backup for OLD."
 234   ;; Support for diffing directories is rather limited.  It needs work.
 235   (interactive (diff-read-args "Diff original file (%s) "
 236                                "Diff new file (%s) "
 237                                "Switches for diff (%s) "
 238                                (buffer-file-name)))
 239   (setq switches (diff-fix-switches (or switches diff-switches))
 240         old (expand-file-name old)
 241         new (expand-file-name new))
 242   (let ((curr-buff (current-buffer))
 243         doing-dirs old-temp new-temp old-buffer new-buffer flag)
 244     (let ((fdp-old (file-directory-p old))
 245           (fdp-new (file-directory-p new)))
 246       (cond
 247        ((null (or fdp-new fdp-old)))
 248        ((null fdp-new)
 249         (setq old (expand-file-name (file-name-nondirectory new) old)))
 250        ((null fdp-old)
 251         (setq new (expand-file-name (file-name-nondirectory old) new)))
 252        (t (setq doing-dirs t))))
 253 ;;    (message "diff %s %s %s..."
 254 ;;           (mapconcat (function identity) switches " ") new old)
 255     (message "diff %s %s %s..."
 256              (mapconcat (function identity) switches " ") old new)
 257     (if doing-dirs
 258         (setq diff-old-file nil
 259               diff-new-file nil)
 260       (setq old-temp (make-temp-name (concat diff-temp-template "1"))
 261             new-temp (make-temp-name (concat diff-temp-template "2"))
 262             old-buffer (diff-get-file-buffer old)
 263             new-buffer (diff-get-file-buffer new)
 264             diff-old-file (cons old (cdr old-buffer))
 265             diff-new-file (cons new (cdr new-buffer))))
 266     (let (case-fold-search)
 267       (mapcar (function
 268                (lambda (x)
 269                  (if (string-match "[ecu]" x)
 270                      (setq flag (aref x (match-beginning 0))))))
 271               switches))
 272     (unwind-protect
 273         (progn
 274           (set-buffer (get-buffer-create "*Diff Output*"))
 275           (setq default-directory (file-name-directory new))
 276           (let (buffer-read-only)
 277             (if (fboundp 'buffer-disable-undo)
 278                 (buffer-disable-undo (current-buffer))
 279               ;; old style (Emacs 18.55 and earlier)
 280               (buffer-disable-undo (current-buffer)))
 281             (widen)
 282             (erase-buffer)
 283             (if doing-dirs
 284                 (diff-run-diff switches old old new new)
 285               (save-excursion
 286                 (set-buffer (car old-buffer))
 287                 (write-region (point-min) (point-max) old-temp nil 'quiet)
 288                 (set-buffer (car new-buffer))
 289                 (write-region (point-min) (point-max) new-temp nil 'quiet))
 290               (diff-run-diff switches old old-temp new new-temp))
 291             ;; Need to replace file names
 292             (if (and (not doing-dirs) (memq flag '(?c ?u)))
 293                 (diff-fix-file-names old old-temp new new-temp
 294                                      diff-hunk-header-re))
 295             (diff-mode)
 296             (goto-char (point-min))
 297             (if diff-do-narrow
 298                 (progn
 299                   (diff-hunk-next)
 300                   (diff-restrict-view)))
 301             (display-buffer (current-buffer))))
 302           (condition-case nil
 303               (delete-file old-temp)
 304             (error nil))
 305           (condition-case nil
 306               (delete-file new-temp)
 307             (error nil))
 308           (set-buffer curr-buff))))
 309
 310 ;;;###autoload
 311 (defun diff-backup (file &optional switches)
 312   "Diff this file with its backup file or vice versa.
 313 Uses the latest backup, if there are several numerical backups.
 314 If this file is a backup, diff it with its original.
 315 The backup file is the first file given to `diff'."
 316   (interactive (list (read-file-name "Diff (file with backup): ")
 317                      (and current-prefix-arg
 318                           (diff-read-switches "Diff switches: "))))
 319   (let (bak ori)
 320     (if (backup-file-name-p file)
 321         (setq bak file
 322               ori (file-name-sans-versions file))
 323       (setq bak (or (diff-latest-backup-file file)
 324                     (error "No backup found for %s" file))
 325             ori file))
 326     (diff bak ori switches)))
 327
 328 ;;; Run any load hooks
 329 (run-hooks 'diff-load-hook)
 330
 331 ;;; end of diff.el