home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / diff.el < prev    next >
Encoding:
Text File  |  1995-05-12  |  10.4 KB  |  300 lines
  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 XEmacs.
  8.  
  9. ;; XEmacs is free software; you can redistribute it and/or modify it
  10. ;; 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. ;; XEmacs is distributed in the hope that it will be useful, but
  15. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;; General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  21. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. ;;; Synched up with: FSF 19.28.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This package helps you explore differences between files, using the
  28. ;; UNIX command diff(1).  The commands are `diff' and `diff-backup'.
  29. ;; You can specify options with `diff-switches'.
  30.  
  31. ;;; Code:
  32.  
  33. (require 'compile)
  34.  
  35. ;;; This is duplicated in vc.el.
  36. ;;;###autoload
  37. (defvar diff-switches (purecopy "-c")
  38.   "*A string or list of strings specifying switches to be be passed to 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.                                                ;;#### undefined??
  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. ;;;###autoload
  164. (defun diff (old new &optional switches)
  165.   "Find and display the differences between OLD and NEW files.
  166. Interactively the current buffer's file name is the default for NEW
  167. and a backup file for NEW is the default for OLD.
  168. With prefix arg, prompt for diff switches."
  169.   (interactive
  170.    (nconc
  171.     (let (oldf newf)
  172.       (nreverse
  173.        (list
  174.     (setq newf (buffer-file-name)
  175.           newf (if (and newf (file-exists-p newf))
  176.                (read-file-name
  177.             (concat "Diff new file: ("
  178.                 (file-name-nondirectory newf) ") ")
  179.             nil newf t)
  180.              (read-file-name "Diff new file: " nil nil t)))
  181.     (setq oldf (file-newest-backup newf)
  182.           oldf (if (and oldf (file-exists-p oldf))
  183.                (read-file-name
  184.             (concat "Diff original file: ("
  185.                 (file-name-nondirectory oldf) ") ")
  186.             (file-name-directory oldf) oldf t)
  187.              (read-file-name "Diff original file: "
  188.                      (file-name-directory newf) nil t))))))
  189.     (if current-prefix-arg
  190.     (list (read-string "Diff switches: "
  191.                (if (stringp diff-switches)
  192.                    diff-switches
  193.                  (mapconcat 'identity diff-switches " "))))
  194.       nil)))
  195.   (setq new (expand-file-name new)
  196.     old (expand-file-name old))
  197.   ;; XEmacs addition -- allow (diff "../old/" "new-file.el") to work
  198.   (cond ((file-directory-p old)
  199.          (or (file-directory-p new)
  200.              (setq old (expand-file-name (file-name-nondirectory new)
  201.                                          (file-name-as-directory old)))))
  202.         ((file-directory-p new)
  203.          (setq new (expand-file-name (file-name-nondirectory old)
  204.                                      (file-name-as-directory new)))))
  205.   (let ((old-alt (file-local-copy old))
  206.     (new-alt (file-local-copy new))
  207.     buf)
  208.     (unwind-protect
  209.     (let ((command
  210.            (mapconcat 'identity
  211.               (append '("diff")
  212.                   ;; Use explicitly specified switches
  213.                   (if switches
  214.                       (if (consp switches)
  215.                       switches (list switches))
  216.                     ;; If not specified, use default.
  217.                     (if (consp diff-switches)
  218.                     diff-switches
  219.                       (list diff-switches)))
  220.                   (if (or old-alt new-alt)
  221.                       (list "-L" old "-L" new))
  222.                   (list
  223.                    (shell-quote-argument (or old-alt old)))
  224.                   (list
  225.                    (shell-quote-argument (or new-alt new))))
  226.               " ")))
  227.       (setq buf
  228.         (compile-internal command
  229.                   "No more differences" "Diff"
  230.                   'diff-parse-differences))
  231.       (pop-to-buffer buf)
  232.       (set (make-local-variable 'diff-old-file) old)
  233.       (set (make-local-variable 'diff-new-file) new)
  234.       (set (make-local-variable 'diff-old-temp-file) old-alt)
  235.       (set (make-local-variable 'diff-new-temp-file) new-alt)
  236.       (set (make-local-variable 'compilation-finish-function)
  237.            (function (lambda (buff msg)
  238.                (if diff-old-temp-file
  239.                    (delete-file diff-old-temp-file))
  240.                (if diff-new-temp-file
  241.                    (delete-file diff-new-temp-file)))))
  242.       buf))))
  243.  
  244. ;;;###autoload
  245. (defun diff-backup (file &optional switches)
  246.   "Diff this file with its backup file or vice versa.
  247. Uses the latest backup, if there are several numerical backups.
  248. If this file is a backup, diff it with its original.
  249. The backup file is the first file given to `diff'."
  250.   (interactive (list (read-file-name "Diff (file with backup): ")
  251.              (if current-prefix-arg
  252.              (read-string "Diff switches: "
  253.                       (if (stringp diff-switches)
  254.                       diff-switches
  255.                     (mapconcat 'identity
  256.                            diff-switches " ")))
  257.                nil)))
  258.   (let (bak ori)
  259.     (if (backup-file-name-p file)
  260.     (setq bak file
  261.           ori (file-name-sans-versions file))
  262.       (setq bak (or (diff-latest-backup-file file)
  263.             (error "No backup found for %s" file))
  264.         ori file))
  265.     (diff bak ori switches)))
  266.  
  267. (defun diff-latest-backup-file (fn)    ; actually belongs into files.el
  268.   "Return the latest existing backup of FILE, or nil."
  269.   (let ((handler (find-file-name-handler fn 'diff-latest-backup-file)))
  270.     (if handler
  271.     (funcall handler 'diff-latest-backup-file fn)
  272.       ;; First try simple backup, then the highest numbered of the
  273.       ;; numbered backups.
  274.       ;; Ignore the value of version-control because we look for existing
  275.       ;; backups, which maybe were made earlier or by another user with
  276.       ;; a different value of version-control.
  277.       (setq fn (file-chase-links (expand-file-name fn)))
  278.       (or
  279.        (let ((bak (make-backup-file-name fn)))
  280.      (if (file-exists-p bak) bak))
  281.        ;; We use BACKUPNAME to cope with backups stored in a different dir.
  282.        (let* ((backupname (car (find-backup-file-name fn)))
  283.           (dir (file-name-directory backupname))
  284.           (base-versions (concat (file-name-sans-versions
  285.                       (file-name-nondirectory backupname))
  286.                      ".~"))
  287.           (bv-length (length base-versions)))
  288.      (concat dir
  289.          (car (sort
  290.                (file-name-all-completions base-versions dir)
  291.                ;; bv-length is a fluid var for backup-extract-version:
  292.                (function
  293.             (lambda (fn1 fn2)
  294.               (> (backup-extract-version fn1)
  295.                  (backup-extract-version fn2))))))))))))
  296.  
  297. (provide 'diff)
  298.  
  299. ;;; diff.el ends here
  300.