xemacs-beta: lisp/packages/diff.el comparison

comparison lisp/packages/diff.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	e04119814345
children	4be1180a9e89

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
-;; -*-Emacs-Lisp-*-
+;;; diff.el --- Run `diff' in compilation-mode.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
+;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
-;; File:         diff.el
-;; Version:      $Revision: 1.4 $
+;; Keywords: unix, tools
-;; Author:       This file is based on diff.el by
-;;               sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
+;; This file is part of XEmacs.
-;;               It has been completely rewritten in July 1994 by
-;;               Sandy Rutherford <sandy@ibm550.sissa.it>
+;; XEmacs is free software; you can redistribute it and/or modify it
-;; RCS:
+;; under the terms of the GNU General Public License as published by
-;; Description:  diff-mode for handling output from unix diff utility.
+;; the Free Software Foundation; either version 2, or (at your option)
-;; Modified:     Wed Jul 17 10:26:57 1996 (Andy Norman) ange@hplb.hpl.hp.com
+;; any later version.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; Copyright (C) 1990 Free Software Foundation, Inc.
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Copyright (C) 1994 Sandy Rutherford
+;; General Public License for more details.
-;;; This file is based on diff.el by sunpitt!wpmstr!fbresz@Sun.COM 1/27/89.
+;; You should have received a copy of the GNU General Public License
-;;; It has been completely rewritten in July 1994 by
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;;; Sandy Rutherford <sandy@ibm550.sissa.it>
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
-;;; 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
+;;; Synched up with: FSF 19.34.
-;;; the Free Software Foundation; either version 1, or (at your option)
-;;; any later version.
+;;; Commentary:
-;;;
-;;; This program is distributed in the hope that it will be useful,
+;; This package helps you explore differences between files, using the
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; UNIX command diff(1).  The commands are `diff' and `diff-backup'.
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; You can specify options with `diff-switches'.
-;;; GNU General Public License for more details.
-;;;
+;;; Code:
-;;; 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
+(require 'compile)
-;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
-;;; MA 02139, USA.
+;;; This is duplicated in vc.el.
-(provide 'diff)
-;;; User Variables
-;; should be in to loaddefs.el now.
 ;;;###autoload
-(defvar diff-switches "-c"
+(defvar diff-switches (purecopy "-c")
-"*A list of switches (strings) to pass to the diff program.")
+"*A string or list of strings specifying switches to be passed to diff.")
-(defvar diff-do-narrow nil
+(defvar diff-command "diff"
-"*If non-nil diff buffers are initialized narrowed to each difference.")
+"*The command to use to run diff.")
-(defvar diff-load-hooks nil
+(defvar diff-regexp-alist
-"Hooks to run after loading diff.el")
+'(
+;; -u format: @@ -OLDSTART,OLDEND +NEWSTART,NEWEND @@
-;;; Internal variables
+("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2)
-(defconst diff-emacs-19-p
+;; -c format: *** OLDSTART,OLDEND ****
-(let ((ver (string-to-int (substring emacs-version 0 2))))
+("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil)
-(>= ver 19)))
+;;            --- NEWSTART,NEWEND ----
+("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1)
-(or diff-emacs-19-p (require 'emacs-19))
+;; plain diff format: OLDSTART[,OLDEND]{a,d,c}NEWSTART[,NEWEND]
-(defvar diff-old-file nil)
+("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3)
-;; A list whose car is the name of the old file, and whose cdr indicates
-;; whether we should delete the buffer on quit.
+;; -e (ed) format: OLDSTART[,OLDEND]{a,d,c}
-(defvar diff-new-file nil)
+("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1)
-;; Same as diff-old-file, except for the new file.
-(defvar diff-total-differences "0")
+;; -f format: {a,d,c}OLDSTART[ OLDEND]
-;; Total number of difference hunks as a string.
+;; -n format: {a,d,c}OLDSTART LINES-CHANGED
-(defvar diff-current-difference "0")
+("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1)
-;; Current difference hunk as a string.
+)
-(defvar diff-current-hunk 0)
+"Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference
-;; Current difference hunk as an integer.
+sections in \\[diff] output.  If REGEXP matches, the OLD-IDX'th
-(defvar diff-total-hunks 0)
+subexpression gives the line number in the old file, and NEW-IDX'th
-;; Total number of difference hunks as an integer.
+subexpression gives the line number in the new file.  If OLD-IDX or NEW-IDX
-(defvar diff-hunk-vector (vector 0))
+is nil, REGEXP matches only half a section.")
-;; Vector storing the starting positions of the difference hunks.
-(defvar diff-old-file-pattern nil)
+(defvar diff-old-file nil
-(defvar diff-new-file-pattern nil)
+"This is the old file name in the comparison in this buffer.")
-(defvar diff-hunk-pattern nil)
+(defvar diff-new-file nil
-;; Regexps to use when parsing file lines in difference hunks.
+"This is the new file name in the comparison in this buffer.")
+(defvar diff-old-temp-file nil
+"This is the name of a temp file to be deleted after diff finishes.")
-(defvar diff-search-pattern-alist
+(defvar diff-new-temp-file nil
-(list
+"This is the name of a temp file to be deleted after diff finishes.")
-(list ?e "^[0-9]\\(,[0-9]+\\)?[acd]$" "^\\([0-9]+\\)" nil)
-(list ?c "^\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\n"
+;; See compilation-parse-errors-function (compile.el).
-	  "^\\*+ \\([0-9]+\\)" "^-+ \\([0-9]+\\)")
+(defun diff-parse-differences (limit-search find-at-least)
-(list ?u "^@@ " "^@@ -\\([0-9]+\\)" "^@@ -[0-9,]+ \\+\\([0-9]+\\)")
+(setq compilation-error-list nil)
-(list nil "^[0-9]+" "^\\([0-9]+\\)" "^[0-9,]+[acd]\\([0-9]+\\)")))
+(message "Parsing differences...")
-(defvar diff-keymap-grokked nil)
+;; Don't reparse diffs already seen at last parse.
+(if compilation-parsing-end (goto-char compilation-parsing-end))
-(defvar diff-temp-template "/tmp/diff")
+;; Construct in REGEXP a regexp composed of all those in dired-regexp-alist.
-;; Initialize the keymap if it isn't already
+(let ((regexp (mapconcat #'(lambda (elt)
+			       (concat "\\(" (car elt) "\\)"))
-(defvar diff-mode-map nil
+			   diff-regexp-alist
-"Keymap used in diff mode.")
+			   "\\|"))
+	;; (GROUP-IDX OLD-IDX NEW-IDX)
-(if diff-mode-map
+	(groups (let ((subexpr 1))
-nil
+		  (mapcar #'(lambda (elt)
-(setq diff-mode-map (make-keymap))
+			    (prog1
-(suppress-keymap diff-mode-map)
+				(cons subexpr
-(define-key diff-mode-map "?" 'describe-mode)
+				      (mapcar #'(lambda (n)
-(define-key diff-mode-map "." 'diff-display-file)
+						(and n
-(define-key diff-mode-map "N" 'diff-narrow)
+						     (+ subexpr n)))
-(define-key diff-mode-map "W" 'widen)
+					      (cdr elt)))
-(define-key diff-mode-map "f" 'diff-find-file)
+			      (setq subexpr (+ subexpr 1
-(define-key diff-mode-map "h" 'diff-show-header)
+;;#### undefined??
-(define-key diff-mode-map "j" 'diff-show-difference)
+					       (count-regexp-groupings
-(define-key diff-mode-map "n" 'diff-next-difference)
+						(car elt))))))
-(define-key diff-mode-map "o" 'diff-find-file-other-window)
+			  diff-regexp-alist)))
-(define-key diff-mode-map "p" 'diff-previous-difference)
-(define-key diff-mode-map "q" 'diff-quit)
+	(new-error
-(define-key diff-mode-map "w" 'diff-find-file-other-frame)
+	 (function (lambda (file subexpr)
-(define-key diff-mode-map "\C-c\C-c" 'diff-find-file-other-window)
+		     (setq compilation-error-list
-(define-key diff-mode-map " " 'diff-advertised-scroll-up)
+			   (cons
-(define-key diff-mode-map "\177" 'diff-advertised-scroll-down)
+			    (cons (save-excursion
-(define-key diff-mode-map "\C-n" 'diff-next-line)
+				    ;; Report location of message
-(define-key diff-mode-map "\C-p" 'diff-previous-line)
+				    ;; at beginning of line.
-(define-key diff-mode-map "\M->" 'diff-end-of-buffer)
+				    (goto-char
-(define-key diff-mode-map "\M-<" 'diff-beginning-of-buffer))
+				     (match-beginning subexpr))
+				    (beginning-of-line)
-;;; Internal functions
+				    (point-marker))
+				  ;; Report location of corresponding text.
-(defun diff-grok-keys (to-command from-command)
+				  (let ((line (string-to-int
-;; Assigns to TO-COMMAND the keys for the global binding of FROM-COMMAND.
+					       (buffer-substring
-;; Does not clobber anything in the local keymap.
+						(match-beginning subexpr)
-(let ((keys (where-is-internal from-command)))
+						(match-end subexpr)))))
-(while keys
+				    (save-excursion
-(condition-case nil
+				      (save-match-data
-	  (if (eq (global-key-binding (car keys)) (key-binding (car keys)))
+					(set-buffer (find-file-noselect file)))
-	      (local-set-key (car keys) to-command))
+				      (save-excursion
-	(error nil))
+					(goto-line line)
-(setq keys (cdr keys)))))
+					(point-marker)))))
+			    compilation-error-list)))))
-(defun diff-grok-keymap ()
-(if diff-keymap-grokked
+	(found-desired nil)
-()
+	(num-loci-found 0)
-(if (and term-setup-hook (boundp 'command-line-args-left))
+	g)
-	(progn
-	  (if diff-emacs-19-p
+(while (and (not found-desired)
-	      (run-hooks term-setup-hook)
+		;; We don't just pass LIMIT-SEARCH to re-search-forward
-	    (funcall term-setup-hook))
+		;; because we want to find matches containing LIMIT-SEARCH
-	  (setq term-setup-hook nil)))
+		;; but which extend past it.
-(setq diff-keymap-grokked t)
+		(re-search-forward regexp nil t))
-(diff-grok-keys 'diff-next-line 'next-line)
-(diff-grok-keys 'diff-previous-line 'previous-line)
+;; Find which individual regexp matched.
-(diff-grok-keys 'diff-forward-char 'forward-char)
+(setq g groups)
-(diff-grok-keys 'diff-backward-char 'backward-char)
+(while (and g (null (match-beginning (car (car g)))))
-(diff-grok-keys 'diff-scroll-up 'scroll-up)
+	(setq g (cdr g)))
-(diff-grok-keys 'diff-scroll-down 'scroll-down)
+(setq g (car g))
-(diff-grok-keys 'diff-beginning-of-buffer 'beginning-of-buffer)
-(diff-grok-keys 'diff-end-of-buffer 'end-of-buffer)))
+(if (nth 1 g)			;OLD-IDX
+	  (funcall new-error diff-old-file (nth 1 g)))
-(defun diff-buffer-narrowed-p ()
+(if (nth 2 g)			;NEW-IDX
-;; Returns t if the current buffer is narrowed
+	  (funcall new-error diff-new-file (nth 2 g)))
-(save-restriction
-(let ((min (point-min))
+(setq num-loci-found (1+ num-loci-found))
-	  (max (point-max)))
+(if (or (and find-at-least
-(widen)
+		   (>= num-loci-found find-at-least))
-(not (and (= min (point-min)) (= max (point-max)))))))
+	      (and limit-search (>= (point) limit-search)))
+	      ;; We have found as many new loci as the user wants,
-(defun diff-current-hunk ()
+	      ;; or the user wanted a specific diff, and we're past it.
-;; Returns the current diff hunk.
+	  (setq found-desired t)))
-(let ((pt (point))
+(if found-desired
-	(start 0)
+	(setq compilation-parsing-end (point))
-	(end (1+ diff-total-hunks))
+;; Set to point-max, not point, so we don't perpetually
-	m)
+;; parse the last bit of text when it isn't a diff header.
-(while (> (- end start) 1)
+(setq compilation-parsing-end (point-max)))
-(setq m (/ (+ start end) 2))
+(message "Parsing differences...done"))
-(if (>= pt (aref diff-hunk-vector m))
+(setq compilation-error-list (nreverse compilation-error-list)))
-	  (setq start m)
-	(setq end m)))
+;;;###autoload
-(if (>= pt (aref diff-hunk-vector end))
+(defun diff (old new &optional switches)
-	(setq m end)
+"Find and display the differences between OLD and NEW files.
-(setq m start))
+Interactively the current buffer's file name is the default for NEW
-;; Don't treat end of buffer as start of next hunk
+and a backup file for NEW is the default for OLD.
-(if (eobp) (1- m) m)))
+With prefix arg, prompt for diff switches."
+(interactive
-(defun diff-hunk-min (n)
+(nconc
-;; Returns the start of the current diff hunk.
+(let (oldf newf)
-(aref diff-hunk-vector n))
+(nreverse
+(list
-(defun diff-hunk-max (n)
+	(setq newf (buffer-file-name)
-;; Returns the end of the current diff hunk.
-(aref diff-hunk-vector (1+ n)))
-(defun diff-parse-hunks ()
-;; Parses a buffer of diff output.
-(save-excursion
-(save-restriction
-(message "Parsing differences...")
-(widen)
-(goto-char (point-min))
-(let ((hunks (list 1)))
-	(while (re-search-forward diff-hunk-pattern nil t)
-	  (setq hunks (cons (match-beginning 0) hunks)))
-	(setq diff-total-hunks (1- (length hunks))
-	      diff-hunk-vector (apply 'vector
-				      (nreverse (cons (point-max) hunks)))))))
-(message "Parsing differences...done"))
-(defun diff-update-modeline ()
-;; Updates the mode line to show current diff hunk.
-(if (or (< (point) (diff-hunk-min diff-current-hunk))
-	  (>= (point) (diff-hunk-max diff-current-hunk)))
-(progn
-	(setq diff-current-hunk (diff-current-hunk)
-	      diff-current-difference (int-to-string diff-current-hunk))
-	(set-buffer-modified-p (buffer-modified-p)))))
-(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))
+			(concat "Diff new file: ("
+				(file-name-nondirectory newf) ") ")
 			nil newf t)
-		     (read-file-name (format newprompt "") nil nil t))
+		     (read-file-name "Diff new file: " nil nil t)))
-	      oldf (file-newest-backup newf)
+	(setq oldf (file-newest-backup newf)
 	      oldf (if (and oldf (file-exists-p oldf))
 		       (read-file-name
-			(format oldprompt (file-name-nondirectory oldf))
+			(concat "Diff original file: ("
-			nil oldf t)
+				(file-name-nondirectory oldf) ") ")
-		     (read-file-name (format oldprompt "")
+			(file-name-directory oldf) oldf t)
-				     (file-name-directory newf) nil t)))
+		     (read-file-name "Diff original file: "
-;; Else we aren't trying to be bright...
+				     (file-name-directory newf) nil t))))))
-(setq oldf (read-file-name (format oldprompt "") nil nil t)
+(if current-prefix-arg
-	    newf (read-file-name
+	(list (read-string "Diff switches: "
-		  (format newprompt (file-name-nondirectory oldf))
+			   (if (stringp diff-switches)
-		  nil (file-name-directory oldf) t)))
+			       diff-switches
-	(list oldf newf (diff-read-switches switchprompt))))
+			     (mapconcat 'identity diff-switches " "))))
+nil)))
-(defun diff-read-switches (switchprompt)
+(setq new (expand-file-name new)
-;; Read and return a list of switches
+	old (expand-file-name old))
-(if current-prefix-arg
+;; XEmacs addition -- allow (diff "../old/" "new-file.el") to work
-(let ((default (if (listp diff-switches)
+(cond ((file-directory-p old)
-			 (mapconcat 'identity diff-switches " ")
+(or (file-directory-p new)
-		       diff-switches)))
+(setq old (expand-file-name (file-name-nondirectory new)
-	(diff-fix-switches
+(file-name-as-directory old)))))
-	 (read-string (format switchprompt default) default)))))
+((file-directory-p new)
+(setq new (expand-file-name (file-name-nondirectory old)
-(defun diff-fix-switches (switch-spec)
+(file-name-as-directory new)))))
-;; Parse a string into a list of switches or leave it be if it's
+(let ((old-alt (file-local-copy old))
-;; not a string
+	(new-alt (file-local-copy new))
-(if (stringp switch-spec)
+	buf)
-(let (result (start 0))
+(unwind-protect
-	(while (string-match "\\(\\S-+\\)" switch-spec start)
+	(let ((command
-	  (setq result (cons (substring switch-spec (match-beginning 1)
+	       (mapconcat 'identity
-					(match-end 1))
+			  (append (list diff-command)
-			     result)
+				  ;; Use explicitly specified switches
-		start (match-end 0)))
+				  (if switches
-	(nreverse result))
+				      (if (consp switches)
-switch-spec))
+					  switches (list switches))
+				    ;; If not specified, use default.
-(defun diff-get-file-buffer (file)
+				    (if (consp diff-switches)
-;; Returns \(BUFFER . DEL-P\), where DEL-P is t if diff is expected
+					diff-switches
-;; to delete the buffer, and nil otherwise.
+				      (list diff-switches)))
-(let* ((buff (get-file-buffer file))
+				  (if (or old-alt new-alt)
-	 (del-p (null buff)))
+				      (list "-L" old "-L" new))
-(if (and buff (buffer-modified-p buff))
+				  (list
-	(progn
+				   (shell-quote-argument (or old-alt old)))
-	  (message
+				  (list
-	   "Buffer %s is modified.  Diffing against buffer contents."
+				   (shell-quote-argument (or new-alt new))))
-	   (buffer-name buff))
+			  " ")))
-	  (sit-for 1)))
+	  (setq buf
-;; Call find-file-noselect even if we already have the buffer,
+		(compile-internal command
-;; as it will run verify-buffer-file-modtime.
+				  "No more differences" "Diff"
-(cons (find-file-noselect file) del-p)))
+				  'diff-parse-differences))
+	  (pop-to-buffer buf)
-(defun diff-cleanup-buffers ()
+	  ;; Avoid frightening people with "abnormally terminated"
-;; Cleans up diff buffers by deleting buffers that we don't expect
+	  ;; if diff finds differences.
-;; the user to care about.
+	  (set (make-local-variable 'compilation-exit-message-function)
-(let ((files (list diff-old-file diff-new-file)))
+	       (lambda (status code msg)
-(while files
+		 (cond ((not (eq status 'exit))
-(let ((ent (car files))
+			(cons msg code))
-	    buff)
+		       ((zerop code)
-	(and (cdr ent)
+			'("finished (no differences)\n" . "no differences"))
-	     (setq buff (get-file-buffer (car ent)))
+		       ((= code 1)
-	     (not (buffer-modified-p buff))
+			'("finished\n" . "differences found"))
-	     (kill-buffer buff)))
+		       (t
-(setq files (cdr files)))
+			(cons msg code)))))
-(if (get-buffer "*Diff Header*")
+	  (set (make-local-variable 'diff-old-file) old)
-	(kill-buffer "*Diff Header*"))))
+	  (set (make-local-variable 'diff-new-file) new)
+	  (set (make-local-variable 'diff-old-temp-file) old-alt)
-(defun diff-latest-backup-file (file)
+	  (set (make-local-variable 'diff-new-temp-file) new-alt)
+	  (set (make-local-variable 'compilation-finish-function)
+	       (function (lambda (buff msg)
+			   (if diff-old-temp-file
+			       (delete-file diff-old-temp-file))
+			   (if diff-new-temp-file
+			       (delete-file diff-new-temp-file)))))
+	  buf))))
+;;;###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): ")
+		     (if current-prefix-arg
+			 (read-string "Diff switches: "
+				      (if (stringp diff-switches)
+					  diff-switches
+					(mapconcat 'identity
+						   diff-switches " ")))
+		       nil)))
+(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)))
+(defun diff-latest-backup-file (fn)	; actually belongs into files.el
 "Return the latest existing backup of FILE, or nil."
-;; First try simple backup, then the highest numbered of the
+(let ((handler (find-file-name-handler fn 'diff-latest-backup-file)))
-;; 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)
+	(funcall handler 'diff-latest-backup-file fn)
+;; 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.
+(setq fn (file-chase-links (expand-file-name fn)))
 (or
-(let ((bak (make-backup-file-name file)))
+(let ((bak (make-backup-file-name fn)))
 	 (if (file-exists-p bak) bak))
-(let* ((dir (file-name-directory file))
+;; We use BACKUPNAME to cope with backups stored in a different dir.
-	      (base-versions (concat (file-name-nondirectory file) ".~"))
+(let* ((backupname (car (find-backup-file-name fn)))
+	      (dir (file-name-directory backupname))
+	      (base-versions (concat (file-name-sans-versions
+				      (file-name-nondirectory backupname))
+				     ".~"))
 	      (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-file-line (&optional old-file-p)
+(provide 'diff)
-"Return line number of current hunk in `diff-new-file'.
-With optional argument OLD-FILE-P, use `diff-old-file' instead."
+;;; diff.el ends here
-(save-excursion
-(let ((min (diff-hunk-min diff-current-hunk))
-	  (max (diff-hunk-max diff-current-hunk))
-	  (regexp (if old-file-p diff-old-file-pattern diff-new-file-pattern)))
-(goto-char min)
-(or (and regexp (re-search-forward regexp max t))
-	  (error "Unable to locate a file line for %s file."
-		 (if old-file-p "old" "new")))
-(string-to-int (buffer-substring (match-beginning 1) (match-end 1))))))
-(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)))))))
-;;;; User commands
-(defun diff-mode ()
-"Diff Mode is used by \\[diff] for perusing the output from the diff program.
-All normal editing commands are turned off.  Instead, these are available:
-\\<diff-mode-map>
-\\[diff-advertised-scroll-up]	Scroll to next screen of this difference.
-\\[diff-advertised-scroll-down]	Scroll to previous screen of this difference.
-\\[diff-next-difference]	Move to Next Difference.
-\\[diff-previous-difference]	Move to Previous Difference.
-\\[diff-show-difference]	Jump to difference specified by numeric position.
-\\[diff-find-file]	Find current diff in file
-\\[diff-find-file-other-window]	Find current diff in file in other window
-\\[diff-display-file]	Display file in other window
-\\[diff-narrow]	Narrow diff buffer to current difference
-\\[widen]	Widen diff buffer
-\\[diff-show-header]	Show diff header describing file name etc.
-\\[diff-quit]	Quit diff
-"
-(interactive)
-(use-local-map diff-mode-map)
-(diff-grok-keymap)
-(setq buffer-read-only t
-	major-mode 'diff-mode
-	mode-name "Diff"
-	mode-line-modified "--- "
-	mode-line-process
-	'(" " diff-current-difference "/" diff-total-differences))
-(diff-parse-hunks)
-(setq diff-total-differences (int-to-string diff-total-hunks)))
-;;; Motion commands
-(defun diff-next-difference (n)
-"In diff-mode go the the beginning of the next difference hunk."
-(interactive "p")
-(if (zerop n)
-(goto-char (diff-hunk-min diff-current-hunk))
-(let ((narrow (diff-buffer-narrowed-p))
-	  (max (point-max))
-	  (min (point-min)))
-(unwind-protect
-	  (progn
-	    (widen)
-	    (setq diff-current-hunk (+ n diff-current-hunk))
-	    (cond ((> diff-current-hunk diff-total-hunks)
-		   (setq diff-current-hunk diff-total-hunks)
-		   (message "No following difference hunks."))
-		  ((< diff-current-hunk 0)
-		   (setq diff-current-hunk 0)
-		   (message "No preceding difference hunks.")))
-	    (setq diff-current-difference (int-to-string diff-current-hunk)
-		  min (goto-char (diff-hunk-min diff-current-hunk))
-		  max (diff-hunk-max diff-current-hunk)))
-	(if narrow (narrow-to-region min max))))
-(set-buffer-modified-p (buffer-modified-p))))
-(defun diff-previous-difference (n)
-"In diff-mode go the the beginning of the previous difference hunk."
-(interactive "p")
-(diff-next-difference (- n)))
-(defun diff-next-line (n)
-"In diff-mode go to the next line."
-(interactive "p")
-(condition-case nil
-(next-line n)
-(error (if (> n 0) (message "End of difference hunk"))))
-(diff-update-modeline))
-(defun diff-previous-line (n)
-"In diff-mode go to the previous line."
-(interactive "p")
-(diff-next-line (- n)))
-(defun diff-forward-char (n)
-"In diff-mode move the point forward."
-(interactive "p")
-(forward-char n)
-(diff-update-modeline))
-(defun diff-backward-char (n)
-"In diff-mode move the point backward."
-(interactive "p")
-(backward-char n)
-(diff-update-modeline))
-(defun diff-scroll-up (n)
-"In diff-mode scroll the buffer up."
-(interactive "P")
-(scroll-up n)
-(diff-update-modeline))
-(fset 'diff-advertised-scroll-up 'diff-scroll-up)
-(defun diff-scroll-down (n)
-"In diff-mode scroll the buffer down."
-(interactive "P")
-(scroll-down n)
-(diff-update-modeline))
-(fset 'diff-advertised-scroll-down 'diff-scroll-down)
-(defun diff-beginning-of-buffer (n)
-"In diff-mode go to the beginning of the buffer."
-(interactive "P")
-(beginning-of-buffer n)
-(diff-update-modeline))
-(defun diff-end-of-buffer (n)
-"In diff-mode go to the end of the buffer."
-(interactive "P")
-(end-of-buffer n)
-(diff-update-modeline))
-;;; The main command.
-;;;###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
-	(let ((patterns (assq flag diff-search-pattern-alist)))
-	  (set-buffer (get-buffer-create "*Diff Output*"))
-	  (setq default-directory (file-name-directory new)
-		diff-old-file-pattern (nth 2 patterns)
-		diff-new-file-pattern (nth 3 patterns)
-		diff-hunk-pattern (nth 1 patterns))
-	  (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
-		(progn
-		  (diff-run-diff switches old old new new)
-		  (setq diff-hunk-pattern (concat diff-hunk-pattern
-						  "\\|^Only in ")))
-	      (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-pattern))
-	    (diff-mode)
-	    (goto-char (point-min))
-	    (setq diff-current-difference "0"
-		  diff-current-hunk 0)
-	    (if (zerop diff-total-hunks)
-		(progn
-		  (diff-cleanup-buffers)
-		  (message "No differences"))
-	      (if diff-do-narrow (narrow-to-region (point) (diff-hunk-max 0)))
-	      (display-buffer (current-buffer))
-	      (message "%s difference hunk%s" diff-total-differences
-		       (if (= diff-total-hunks 1) "" "s")))))
-(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)))
-(defun diff-show-difference (n)
-"Show difference number N (prefix argument)."
-(interactive "p")
-(let ((narrowedp (diff-buffer-narrowed-p))
-	(min (diff-hunk-min diff-current-hunk))
-	(max (diff-hunk-max diff-current-hunk)))
-(unwind-protect
-	(progn
-	  (widen)
-	  (cond
-	   ((< n 0)
-	    (message "No negative hunks.")
-	    (setq n 0))
-	   ((> n diff-total-hunks)
-	    (message "No hunk %d." n)
-	    (setq n diff-total-hunks)))
-	  (setq diff-current-hunk n
-		diff-current-difference (int-to-string diff-current-hunk)
-		min (diff-hunk-min n)
-		max (diff-hunk-max n))
-	  (goto-char min))
-(if narrowedp (narrow-to-region min max))
-(set-buffer-modified-p (buffer-modified-p)))))
-(defun diff-show-header ()
-"Show `diff-header'."
-(interactive)
-(with-output-to-temp-buffer "*Diff Header*"
-(princ (save-restriction
-	     (widen)
-	     (buffer-substring (diff-hunk-min 0) (diff-hunk-max 0))))))
-(defun diff-find-file (old-file-p)
-"Visit diffed file, at the point corresponding to the current hunk.
-Default is to visit the new file; prefix means visit old file instead."
-(interactive "P")
-(let ((line (diff-file-line old-file-p)))
-(find-file
-(if old-file-p
-	 (car diff-old-file)
-(car diff-new-file)))
-(goto-line line)
-(recenter 0)))
-(defun diff-find-file-other-window (old-file-p)
-"Visit the diffed file in other window, with the point at the current hunk.
-Default is to visit the new file; prefix means visit the old file instead."
-(interactive "P")
-(let ((line (diff-file-line old-file-p)))
-(find-file-other-window
-(if old-file-p
-	 (car diff-old-file)
-(car diff-new-file)))
-(goto-line line)
-(recenter 0)))
-(defun diff-find-file-other-frame (old-file-p)
-"Visit the diffed file in other frame, with point at the current hunk.
-Default is to visit the new file; prefix means visit the old file instead."
-(interactive "P")
-(let ((line (diff-file-line old-file-p)))
-(find-file-other-frame
-(if old-file-p
-	 (car diff-old-file)
-(car diff-new-file)))
-(goto-line line)
-(recenter 0)))
-(defun diff-display-file (old-file-p)
-"Display the diffed file in other window, with point at the current hunk.
-Default is to visit the new file; prefix means visit the old file instead."
-(interactive "P")
-(let ((line (diff-file-line old-file-p))
-	(wind (display-buffer (find-file-noselect (if old-file-p
-						      (car diff-old-file)
-						    (car diff-new-file)))))
-	(curr-wind (selected-window)))
-(unwind-protect
-	(progn
-	  (select-window wind)
-	  (goto-line line)
-	  (recenter 0))
-(select-window curr-wind))))
-(defun diff-quit ()
-"Quit diff by killing the diff buffer."
-(interactive)
-(kill-buffer "*Diff Output*")
-(diff-cleanup-buffers))
-(defun diff-narrow ()
-"Narrow diff buffer to current difference hunk."
-(interactive)
-(narrow-to-region (diff-hunk-min diff-current-hunk)
-		    (diff-hunk-max diff-current-hunk)))
-;;; Run any load hooks
-(run-hooks 'diff-load-hook)
-;;; end of diff.el

Mercurial > hg > xemacs-beta

comparison lisp/packages/diff.el @ 70:131b0175ea99 r20-0b30