lisp/diff.el

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