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