lisp/diff.el

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