Source

dired / diff.el

Full commit
;; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File:         diff.el
;; Version:      #Revision: 4.0 $
;; Author:       This file is based on diff.el by
;;               sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
;;               It has been completely rewritten in July 1994 by
;;               Sandy Rutherford <sandy@ibm550.sissa.it>
;;               It has mostly been demolished in March 2001 by
;;               Mike Sperber <mike@xemacs.org> to use
;;               Stefan Monnier's diff-mode.
;; RCS:          
;; Description:  Call unix diff utility.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Copyright (C) 1990 Free Software Foundation, Inc.
;;; Copyright (C) 1994 Sandy Rutherford

;;; This file is based on diff.el by sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
;;; It has been completely rewritten in July 1994 by
;;; Sandy Rutherford <sandy@ibm550.sissa.it>
;;; It has mostly been demolished in March 2001 by
;;; Mike Sperber <mike@xemacs.org> to use

;;; 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 1, 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.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to sandy@ibm550.sissa.it) or
;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
;;; MA 02139, USA.

(require 'custom)
(require 'diff-mode)

(provide 'diff)

;;; User Variables

(defgroup diff nil
  "Handling output from Unix diff utility"
  :group 'tools)

;; should be in to loaddefs.el now.
;;;###autoload
(defcustom diff-switches "-c"
  "*A list of switches (strings) to pass to the diff program."
  :type '(choice string
		 (repeat string))
  :group 'diff)

(defcustom diff-do-narrow nil
  "*If non-nil diff buffers are initialized narrowed to each difference."
  :type 'boolean
  :group 'diff)

(defcustom diff-load-hooks nil
  "Hooks to run after loading diff.el"
  :type 'hook
  :group 'diff)

;;; Internal variables

(defconst diff-emacs-19-p
  (let ((ver (string-to-int (substring emacs-version 0 2))))
    (>= ver 19)))

(or diff-emacs-19-p (require 'emacs-19))

(defvar diff-old-file nil)
;; A list whose car is the name of the old file, and whose cdr indicates
;; whether we should delete the buffer on quit.
(defvar diff-new-file nil)
;; Same as diff-old-file, except for the new file.

(defvar diff-temp-template (expand-file-name "diff" (temp-directory)))

(defun diff-read-args (oldprompt newprompt switchprompt
				 &optional file-for-backup)
  ;; Grab the args for diff.  OLDPROMPT and NEWPROMPT are the prompts
  ;; for the old & new filenames, SWITCHPROMPT for the list of
  ;; switches.  If FILE_FOR_BACKUP is provided (it must be a string if
  ;; so), then it will be used to try & work out a file & backup to
  ;; diff, & in this case the prompting order is backwards.  %s in a
  ;; prompt has a guess substituted into it.  This is nasty.
  (let (oldf newf)
    (if file-for-backup
	(setq newf file-for-backup
	      newf (if (and newf (file-exists-p newf))
		       (read-file-name
			(format newprompt (file-name-nondirectory newf))
			nil newf t)
		     (read-file-name (format newprompt "") nil nil t))
	      oldf (file-newest-backup newf)
	      oldf (if (and oldf (file-exists-p oldf))
		       (read-file-name
			(format oldprompt (file-name-nondirectory oldf))
			nil oldf t)
		     (read-file-name (format oldprompt "")
				     (file-name-directory newf) nil t)))
      ;; Else we aren't trying to be bright...
      (setq oldf (read-file-name (format oldprompt "") nil nil t)
	    newf (read-file-name
		  (format newprompt (file-name-nondirectory oldf))
		  nil (file-name-directory oldf) t)))
	(list oldf newf (diff-read-switches switchprompt))))

(defun diff-read-switches (switchprompt)
  ;; Read and return a list of switches
  (if current-prefix-arg
      (let ((default (if (listp diff-switches)
			 (mapconcat 'identity diff-switches " ")
		       diff-switches)))
	(diff-fix-switches
	 (read-string (format switchprompt default) default)))))

(defun diff-fix-switches (switch-spec)
  ;; Parse a string into a list of switches or leave it be if it's
  ;; not a string
  (if (stringp switch-spec)
      (let (result (start 0))
	(while (string-match "\\(\\S-+\\)" switch-spec start)
	  (setq result (cons (substring switch-spec (match-beginning 1)
					(match-end 1))
			     result)
		start (match-end 0)))
	(nreverse result))
    switch-spec))

(defun diff-get-file-buffer (file)
  ;; Returns \(BUFFER . DEL-P\), where DEL-P is t if diff is expected
  ;; to delete the buffer, and nil otherwise.
  (let* ((buff (get-file-buffer file))
	 (del-p (null buff)))
    (if (and buff (buffer-modified-p buff))
	(progn
	  (message
	   "Buffer %s is modified.  Diffing against buffer contents."
	   (buffer-name buff))
	  (sit-for 1)))
    ;; Call find-file-noselect even if we already have the buffer,
    ;; as it will run verify-buffer-file-modtime.
    (cons (find-file-noselect file) del-p)))

(defun diff-cleanup-buffers ()
  ;; Cleans up diff buffers by deleting buffers that we don't expect
  ;; the user to care about.
  (let ((files (list diff-old-file diff-new-file)))
    (while files
      (let ((ent (car files))
	    buff)
	(and (cdr ent)
	     (setq buff (get-file-buffer (car ent)))
	     (not (buffer-modified-p buff))
	     (kill-buffer buff)))
      (setq files (cdr files)))
    (if (get-buffer "*Diff Header*")
	(kill-buffer "*Diff Header*"))))

(defun diff-latest-backup-file (file)
  "Return the latest existing backup of FILE, or nil."
  ;; First try simple backup, then the highest numbered of the
  ;; numbered backups.
  ;; Ignore the value of version-control because we look for existing
  ;; backups, which maybe were made earlier or by another user with
  ;; a different value of version-control.
  (let* ((file (expand-file-name file))
	 (handler (find-file-name-handler file 'diff-latest-backup-file)))
    (if handler
	(funcall handler 'diff-latest-backup-file file)
      (or
       (let ((bak (make-backup-file-name file)))
	 (if (file-exists-p bak) bak))
       (let* ((dir (file-name-directory file))
	      (base-versions (concat (file-name-nondirectory file) ".~"))
	      (bv-length (length base-versions)))
	 (concat dir
		 (car (sort
		       (file-name-all-completions base-versions dir)
		       ;; bv-length is a fluid var for backup-extract-version:
		       (function
			(lambda (fn1 fn2)
			  (> (backup-extract-version fn1)
			     (backup-extract-version fn2))))))))))))

(defun diff-run-diff (switches old old-temp new new-temp)
  ;; Actually run the diff process with SWITCHES on OLD and NEW.
  ;; OLD-TEMP and NEW-TEMP are names of temp files that can be used
  ;; to dump the data out to.
  (insert "diff " (mapconcat 'identity switches " ") " " old
	  " " new "\n")
  (apply 'call-process "diff" nil t nil
	 (append switches (list old-temp new-temp))))


(defun diff-fix-file-names (old old-temp new new-temp pattern)
  ;; Replaces any temp file names with the real names of files.
  (save-excursion
    (save-restriction
      (let ((files (list old new))
	    (temps (list old-temp new-temp))
	    buffer-read-only case-fold-search)
	(goto-char (point-min))
	(if (re-search-forward pattern nil t)
	    (narrow-to-region (point-min) (match-beginning 0)))
	(while files
	  (let ((regexp (concat "[ \t\n]\\("
				(regexp-quote (car temps))
				"\\)[ \t\n]")))
	    (goto-char (point-min))
	    (forward-line 1)
	    (while (re-search-forward regexp nil t)
	      (goto-char (match-beginning 1))
	      (delete-region (point) (match-end 1))
	      (insert (car files))))
	  (setq files (cdr files)
		temps (cdr temps)))))))

;;;###autoload
(defun diff (old new &optional switches)
  "Find and display the differences between OLD and NEW files.
Interactively you are prompted with the current buffer's file name for NEW
and what appears to be its backup for OLD."
  ;; Support for diffing directories is rather limited.  It needs work.
  (interactive (diff-read-args "Diff original file (%s) "
			       "Diff new file (%s) "
			       "Switches for diff (%s) "
			       (buffer-file-name)))
  (setq switches (diff-fix-switches (or switches diff-switches))
	old (expand-file-name old)
	new (expand-file-name new))
  (let ((curr-buff (current-buffer))
	doing-dirs old-temp new-temp old-buffer new-buffer flag)
    (let ((fdp-old (file-directory-p old))
	  (fdp-new (file-directory-p new)))
      (cond
       ((null (or fdp-new fdp-old)))
       ((null fdp-new)
	(setq old (expand-file-name (file-name-nondirectory new) old)))
       ((null fdp-old)
	(setq new (expand-file-name (file-name-nondirectory old) new)))
       (t (setq doing-dirs t))))
;;    (message "diff %s %s %s..."
;;	     (mapconcat (function identity) switches " ") new old)
    (message "diff %s %s %s..."
	     (mapconcat (function identity) switches " ") old new)
    (if doing-dirs
	(setq diff-old-file nil
	      diff-new-file nil)
      (setq old-temp (make-temp-name (concat diff-temp-template "1"))
	    new-temp (make-temp-name (concat diff-temp-template "2"))
	    old-buffer (diff-get-file-buffer old)
	    new-buffer (diff-get-file-buffer new)
	    diff-old-file (cons old (cdr old-buffer))
	    diff-new-file (cons new (cdr new-buffer))))
    (let (case-fold-search)
      (mapcar (function
	       (lambda (x)
		 (if (string-match "[ecu]" x)
		     (setq flag (aref x (match-beginning 0))))))
	      switches))
    (unwind-protect
	(progn
	  (set-buffer (get-buffer-create "*Diff Output*"))
	  (setq default-directory (file-name-directory new))
	  (let (buffer-read-only)
	    (if (fboundp 'buffer-disable-undo)
		(buffer-disable-undo (current-buffer))
	      ;; old style (Emacs 18.55 and earlier)
	      (buffer-disable-undo (current-buffer)))
	    (widen)
	    (erase-buffer)
	    (if doing-dirs
		(diff-run-diff switches old old new new)
	      (save-excursion
		(set-buffer (car old-buffer))
		(write-region (point-min) (point-max) old-temp nil 'quiet)
		(set-buffer (car new-buffer))
		(write-region (point-min) (point-max) new-temp nil 'quiet))
	      (diff-run-diff switches old old-temp new new-temp))
	    ;; Need to replace file names
	    (if (and (not doing-dirs) (memq flag '(?c ?u)))
		(diff-fix-file-names old old-temp new new-temp
				     diff-hunk-header-re))
	    (diff-mode)
	    (goto-char (point-min))
	    (if diff-do-narrow
		(progn
		  (diff-next-hunk)
		  (diff-restrict-view)))
	    (display-buffer (current-buffer))))
	  (condition-case nil
	      (delete-file old-temp)
	    (error nil))
	  (condition-case nil
	      (delete-file new-temp)
	    (error nil))
	  (set-buffer curr-buff))))

;;;###autoload
(defun diff-backup (file &optional switches)
  "Diff this file with its backup file or vice versa.
Uses the latest backup, if there are several numerical backups.
If this file is a backup, diff it with its original.
The backup file is the first file given to `diff'."
  (interactive (list (read-file-name "Diff (file with backup): ")
		     (and current-prefix-arg
			  (diff-read-switches "Diff switches: "))))
  (let (bak ori)
    (if (backup-file-name-p file)
	(setq bak file
	      ori (file-name-sans-versions file))
      (setq bak (or (diff-latest-backup-file file)
		    (error "No backup found for %s" file))
	    ori file))
    (diff bak ori switches)))

;;; Run any load hooks
(run-hooks 'diff-load-hook)

;;; end of diff.el