code.delx.au - gnu-emacs/blob - lisp/diff.el

   1 ;;; diff.el --- Run `diff' in compilation-mode.
   2
   3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   4
   5 ;; Keyword: unix, tools
   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
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Code:
  24
  25 (require 'compile)
  26
  27 (defvar diff-switches "-c"
  28   "*A string or list of strings specifying switches to be be passed to diff.")
  29
  30 (defvar diff-regexp-alist
  31   '(
  32     ;; -u format: @@ -OLDSTART,OLDEND +NEWSTART,NEWEND @@
  33     ("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2)
  34
  35     ;; -c format: *** OLDSTART,OLDEND ****
  36     ("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil)
  37     ;;            --- NEWSTART,NEWEND ----
  38     ("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1)
  39
  40     ;; plain diff format: OLDSTART[,OLDEND]{a,d,c}NEWSTART[,NEWEND]
  41     ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3)
  42
  43     ;; -e (ed) format: OLDSTART[,OLDEND]{a,d,c}
  44     ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1)
  45
  46     ;; -f format: {a,d,c}OLDSTART[ OLDEND]
  47     ;; -n format: {a,d,c}OLDSTART LINES-CHANGED
  48     ("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1)
  49     )
  50   "Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference
  51 sections in \\[diff] output.  If REGEXP matches, the OLD-IDX'th
  52 subexpression gives the line number in the old file, and NEW-IDX'th
  53 subexpression gives the line number in the new file.  If OLD-IDX or NEW-IDX
  54 is nil, REGEXP matches only half a section.")
  55
  56 (defvar diff-old-file nil
  57   "This is the old file name in the comparison in this buffer.")
  58 (defvar diff-new-file nil
  59   "This is the new file name in the comparison in this buffer.")
  60 (defvar diff-old-temp-file nil
  61   "This is the name of a temp file to be deleted after diff finishes.")
  62 (defvar diff-new-temp-file nil
  63   "This is the name of a temp file to be deleted after diff finishes.")
  64
  65 ;; See compilation-parse-errors-function (compile.el).
  66 (defun diff-parse-differences (limit-search find-at-least)
  67   (setq compilation-error-list nil)
  68   (message "Parsing differences...")
  69
  70   ;; Don't reparse diffs already seen at last parse.
  71   (goto-char compilation-parsing-end)
  72
  73   ;; Construct in REGEXP a regexp composed of all those in dired-regexp-alist.
  74   (let ((regexp (mapconcat (lambda (elt)
  75                              (concat "\\(" (car elt) "\\)"))
  76                            diff-regexp-alist
  77                            "\\|"))
  78         ;; (GROUP-IDX OLD-IDX NEW-IDX)
  79         (groups (let ((subexpr 1))
  80                   (mapcar (lambda (elt)
  81                             (prog1
  82                                 (cons subexpr
  83                                       (mapcar (lambda (n)
  84                                                 (and n
  85                                                      (+ subexpr n)))
  86                                               (cdr elt)))
  87                               (setq subexpr (+ subexpr 1
  88                                                (count-regexp-groupings
  89                                                 (car elt))))))
  90                           diff-regexp-alist)))
  91
  92         (new-error
  93          (function (lambda (file subexpr)
  94                      (setq compilation-error-list
  95                            (cons
  96                             (cons (save-excursion
  97                                     ;; Report location of message
  98                                     ;; at beginning of line.
  99                                     (goto-char
 100                                      (match-beginning subexpr))
 101                                     (beginning-of-line)
 102                                     (point-marker))
 103                                   ;; Report location of corresponding text.
 104                                   (let ((line (string-to-int
 105                                                (buffer-substring
 106                                                 (match-beginning subexpr)
 107                                                 (match-end subexpr)))))
 108                                     (save-excursion
 109                                       (set-buffer (find-file-noselect file))
 110                                       (save-excursion
 111                                         (goto-line line)
 112                                         (point-marker)))))
 113                             compilation-error-list)))))
 114
 115         (found-desired nil)
 116         (num-loci-found 0)
 117         g)
 118
 119     (while (and (not found-desired)
 120                 ;; We don't just pass LIMIT-SEARCH to re-search-forward
 121                 ;; because we want to find matches containing LIMIT-SEARCH
 122                 ;; but which extend past it.
 123                 (re-search-forward regexp nil t))
 124
 125       ;; Find which individual regexp matched.
 126       (setq g groups)
 127       (while (and g (null (match-beginning (car (car g)))))
 128         (setq g (cdr g)))
 129       (setq g (car g))
 130
 131       (if (nth 1 g)                     ;OLD-IDX
 132           (funcall new-error diff-old-file (nth 1 g)))
 133       (if (nth 2 g)                     ;NEW-IDX
 134           (funcall new-error diff-new-file (nth 2 g)))
 135
 136       (setq num-loci-found (1+ num-loci-found))
 137       (if (or (and find-at-least
 138                    (>= num-loci-found find-at-least))
 139               (and limit-search (>= (point) limit-search)))
 140               ;; We have found as many new loci as the user wants,
 141               ;; or the user wanted a specific diff, and we're past it.
 142           (setq found-desired t)))
 143     (if found-desired
 144         (setq compilation-parsing-end (point))
 145       ;; Set to point-max, not point, so we don't perpetually
 146       ;; parse the last bit of text when it isn't a diff header.
 147       (setq compilation-parsing-end (point-max)))
 148     (message "Parsing differences...done"))
 149   (setq compilation-error-list (nreverse compilation-error-list)))
 150
 151 ;;;###autoload
 152 (defun diff (old new &optional switches)
 153   "Find and display the differences between OLD and NEW files.
 154 Interactively the current buffer's file name is the default for for NEW
 155 and a backup file for NEW is the default for OLD.
 156 With prefix arg, prompt for diff switches."
 157   (interactive
 158    (nconc
 159     (let (oldf newf)
 160       (nreverse
 161        (list
 162         (setq newf (buffer-file-name)
 163               newf (if (and newf (file-exists-p newf))
 164                        (read-file-name
 165                         (concat "Diff new file: ("
 166                                 (file-name-nondirectory newf) ") ")
 167                         nil newf t)
 168                      (read-file-name "Diff new file: " nil nil t)))
 169         (setq oldf (file-newest-backup newf)
 170               oldf (if (and oldf (file-exists-p oldf))
 171                        (read-file-name
 172                         (concat "Diff original file: ("
 173                                 (file-name-nondirectory oldf) ") ")
 174                         (file-name-directory oldf) oldf t)
 175                      (read-file-name "Diff original file: "
 176                                      (file-name-directory newf) nil t))))))
 177     (if current-prefix-arg
 178         (list (read-string "Diff switches: "
 179                            (if (stringp diff-switches)
 180                                diff-switches
 181                              (mapconcat 'identity diff-switches " "))))
 182       nil)))
 183   (setq new (expand-file-name new)
 184         old (expand-file-name old))
 185   (let ((old-alt (file-local-copy old))
 186         (new-alt (file-local-copy new))
 187         buf)
 188     (unwind-protect
 189         (let ((command
 190                (mapconcat 'identity
 191                           (append '("diff")
 192                                   (if (consp diff-switches)
 193                                       diff-switches
 194                                     (list diff-switches))
 195                                   (if (or old-alt new-alt)
 196                                       (list "-L" old "-L" new))
 197                                   (list (or old-alt old))
 198                                   (list (or new-alt new)))
 199                           " ")))
 200           (setq buf
 201                 (compile-internal command
 202                                   "No more differences" "Diff"
 203                                   'diff-parse-differences))
 204           (save-excursion
 205             (set-buffer buf)
 206             (set (make-local-variable 'diff-old-file) old)
 207             (set (make-local-variable 'diff-new-file) new)
 208             (set (make-local-variable 'diff-old-temp-file) old-alt)
 209             (set (make-local-variable 'diff-new-temp-file) new-alt)
 210             (set (make-local-variable 'compilation-finish-function)
 211                  (function (lambda (buff msg)
 212                              (if diff-old-temp-file
 213                                  (delete-file diff-old-temp-file))
 214                              (if diff-new-temp-file
 215                                  (delete-file diff-new-temp-file))))))
 216           buf))))
 217
 218 ;;;###autoload
 219 (defun diff-backup (file &optional switches)
 220   "Diff this file with its backup file or vice versa.
 221 Uses the latest backup, if there are several numerical backups.
 222 If this file is a backup, diff it with its original.
 223 The backup file is the first file given to `diff'."
 224   (interactive (list (read-file-name "Diff (file with backup): ")
 225                      (if current-prefix-arg
 226                          (read-string "Diff switches: "
 227                                       (if (stringp diff-switches)
 228                                           diff-switches
 229                                         (mapconcat 'identity
 230                                                    diff-switches " ")))
 231                        nil)))
 232   (let (bak ori)
 233     (if (backup-file-name-p file)
 234         (setq bak file
 235               ori (file-name-sans-versions file))
 236       (setq bak (or (diff-latest-backup-file file)
 237                     (error "No backup found for %s" file))
 238             ori file))
 239     (diff bak ori switches)))
 240
 241 (defun diff-latest-backup-file (fn)     ; actually belongs into files.el
 242   "Return the latest existing backup of FILE, or nil."
 243   ;; First try simple backup, then the highest numbered of the
 244   ;; numbered backups.
 245   ;; Ignore the value of version-control because we look for existing
 246   ;; backups, which maybe were made earlier or by another user with
 247   ;; a different value of version-control.
 248   (setq fn (expand-file-name fn))
 249   (or
 250    (let ((bak (make-backup-file-name fn)))
 251      (if (file-exists-p bak) bak))
 252    (let* ((dir (file-name-directory fn))
 253           (base-versions (concat (file-name-nondirectory fn) ".~"))
 254           (bv-length (length base-versions)))
 255      (concat dir
 256              (car (sort
 257                    (file-name-all-completions base-versions dir)
 258                    ;; bv-length is a fluid var for backup-extract-version:
 259                    (function
 260                     (lambda (fn1 fn2)
 261                       (> (backup-extract-version fn1)
 262                          (backup-extract-version fn2))))))))))
 263
 264 ;;; diff.el ends here