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