cgit.sxemacs.org Git - packages/blob - xemacs-packages/patcher/lisp/patcher-diff.el

   1 ;;; patcher-diff.el --- Diff utilities
   2
   3 ;; Copyright (C) 2008, 2009, 2010 Didier Verna
   4 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Didier Verna
   5
   6 ;; Author:        Didier Verna <didier@xemacs.org>
   7 ;; Maintainer:    Didier Verna <didier@xemacs.org>
   8 ;; Created:       Sun Feb 14 16:58:16 2010
   9 ;; Last Revision: Fri Dec  2 22:11:00 2011
  10 ;; Keywords:      maint
  11
  12
  13 ;; This file is part of Patcher.
  14
  15 ;; Patcher is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License version 3,
  17 ;; as published by the Free Software Foundation.
  18
  19 ;; Patcher is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; if not, write to the Free Software
  26 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28
  29 ;;; Commentary:
  30
  31 ;; Contents management by FCM version 0.1.
  32
  33
  34 ;;; Code:
  35
  36 (require 'cl)
  37
  38 (eval-when-compile (require 'patcher-cutil))
  39 (require 'patcher-util)
  40 (require 'patcher-project)
  41 (require 'patcher-instance)
  42 (require 'patcher-source)
  43 (require 'patcher-change-log)
  44
  45
  46 \f
  47 ;; ==========================================================================
  48 ;; Utilities
  49 ;; ==========================================================================
  50
  51 (defun* patcher-run-after-diff-hook
  52     (project min max
  53      &aux (after-diff-hook (patcher-project-option project :after-diff-hook)))
  54   ;; Run PROJECT's after-diff-hook in current buffer, between MIN and MAX.
  55   (when after-diff-hook
  56     (patcher-with-progression "Running the after-diff hook"
  57       (mapcar (lambda (func)
  58                 (funcall func min max))
  59               after-diff-hook))))
  60
  61
  62
  63 \f
  64 ;; ==========================================================================
  65 ;; Diff creation and parsing
  66 ;; ==========================================================================
  67
  68 (defun patcher-parse-diff (project min max)
  69   ;; Parse PROJECT's diff output in current buffer between MIN and MAX.
  70   ;; For each diffed file, create extents with the following properties:
  71   ;; 'patcher-project = PROJECT, and
  72   ;; 'patcher-change-log = <absolute filename> for ChangeLog files, or
  73   ;; 'patcher-source = <absolute filename> for source files.
  74   (patcher-with-progression "Parsing the diff output"
  75     (save-excursion
  76       (goto-char min)
  77       (let* ((diff-header (patcher-project-option project :diff-header t))
  78              (change-logs-updating (patcher-project-option project
  79                                      :change-logs-updating))
  80              (regexp         (nth 0 diff-header))
  81              (old-file-match (nth 1 diff-header))
  82              (new-file-match (nth 2 diff-header))
  83              change-log
  84              old-file old-absfile
  85              new-file new-absfile
  86              beg end)
  87         (while (re-search-forward regexp max t)
  88           (setq beg (match-beginning 0))
  89           (setq old-file (match-string old-file-match))
  90           (setq new-file (match-string new-file-match))
  91           (if (string= old-file "/dev/null")
  92               (setq old-file nil)
  93             (setq old-absfile (expand-file-name old-file default-directory)))
  94           (if (string= new-file "/dev/null")
  95               (setq new-file nil)
  96             (setq new-absfile (expand-file-name new-file default-directory)))
  97           (setq end (or (save-excursion
  98                           (when (re-search-forward regexp max t)
  99                             (match-beginning 0)))
 100                         max))
 101           ;; #### NOTE: the extent properties below are set in relation with
 102           ;; NEW-FILE, unless we're facing a deletion, in which case we use
 103           ;; OLD-FILE instead.
 104           (when change-logs-updating
 105             (setq change-log (patcher-locate-change-log project
 106                                (or new-absfile old-absfile))))
 107           (set-extent-properties (make-extent beg end)
 108                                  `(start-open t
 109                                    duplicable t
 110                                    patcher-project ,project
 111                                    ,(if (and change-log
 112                                              (string= change-log
 113                                                       (or new-absfile
 114                                                           old-absfile)))
 115                                         'patcher-change-log
 116                                         'patcher-source)
 117                                    ,(or new-absfile old-absfile))))))))
 118
 119 (patcher-define-error 'diff
 120   "Patcher diff error."
 121   'process)
 122
 123 (put 'patcher-diff 'lisp-indent-function 2)
 124 (defun* patcher-diff
 125     (project command &key (erase t) (progression "Diff'ing the project"))
 126   ;; Create a PROJECT diff with COMMAND in process buffer.
 127   ;; If ERASE (the default), erase the process buffer first.
 128   ;; Otherwise, insert the diff at current point.
 129   ;; Use PROGRESSION message to make people wait.
 130   ;; After the diff is created, run the diff line filter, the after diff hook
 131   ;; and parse the diff output.
 132   ;; Throw a PATCHER-DIFF error if COMMAND fails.
 133   (multiple-value-bind (min max)
 134       (patcher-condition-case nil
 135           (patcher-call-command project command
 136             :erase erase
 137             :progression progression
 138             :ignore-exit-status
 139             (patcher-project-option project :ignore-diff-status))
 140         (process
 141          (patcher-error 'diff command)))
 142     (with-current-buffer (patcher-project-process-buffer project)
 143       ;; We need a marker in case the hook modifies the diff output.
 144       (goto-char max)
 145       (setq max (point-marker))
 146       (let ((diff-line-filter (patcher-project-option project
 147                                 :diff-line-filter)))
 148         (when diff-line-filter
 149           (operate-on-matching-lines diff-line-filter t nil min max)))
 150       (patcher-run-after-diff-hook project min max)
 151       (patcher-parse-diff project min max))))
 152
 153 (defun patcher-diff-change-logs (project)
 154   ;; Create PROJECT's ChangeLog diff.
 155   ;; This function assumes that ChangeLog files are already known and filled
 156   ;; in properly.
 157   (patcher-save-change-logs project)
 158   (patcher-diff project (patcher-command project
 159                           (or (patcher-project-option project
 160                                 :change-logs-diff-command)
 161                               (patcher-project-diff-command project))
 162                           (mapcar #'patcher-file-relative-name
 163                                   (patcher-project-change-logs project)))
 164     :progression "Generating the ChangeLogs diff")
 165   (patcher-detect-missing-change-logs project))
 166
 167 (defun* patcher-convert-change-logs-diff
 168     (project
 169      ;; Here so that it triggers an error if nil, before doing anything else.
 170      &aux (change-logs-diff-command (patcher-project-option project
 171                                       :change-logs-diff-command t))
 172           (buffer (patcher-project-process-buffer project))
 173           change-log)
 174   ;; Convert PROJECT's ChangeLog diffs in process buffer.
 175   ;; Conversion is done directly in place with the ChangeLog-specific diff
 176   ;; command.
 177   (patcher-with-progression "Converting the ChangeLogs diff"
 178     (with-current-buffer buffer
 179       ;; #### WARNING: deleting extents from within mapcar-extents seems
 180       ;; unsafe. Besides, if I modify the extents'contents instead of deleting
 181       ;; and recreating them, map(car)-extents goes into an infinite loop, on
 182       ;; all extents over and over again.
 183       (dolist (extent (patcher-change-log-extents))
 184         (setq change-log (extent-property extent 'patcher-change-log))
 185         (goto-char (extent-start-position extent))
 186         (patcher-delete-extent-and-region extent)
 187         (patcher-diff project
 188             (patcher-command project change-logs-diff-command
 189                              (list (patcher-file-relative-name change-log)))
 190           :erase nil
 191           :progression (format "Processing %s" change-log))))))
 192
 193 (defun patcher-diff-all (project)
 194   ;; Create PROJECT's global diff with both ChangeLog and source files.
 195   ;; This function assumes that ChangeLog files are already known and filled
 196   ;; in properly.
 197   (patcher-save-sources project)
 198   (patcher-save-change-logs project)
 199   (patcher-diff project
 200       (patcher-command project (patcher-project-diff-command project) t)
 201     :progression "Generating global diff")
 202   (patcher-detect-inconsistent-sources project)
 203   (patcher-detect-inconsistent-change-logs project)
 204   (when (patcher-project-option project :change-logs-diff-command)
 205     (patcher-convert-change-logs-diff project)))
 206
 207 (defun* patcher-diff-specification
 208     (project
 209      &aux (buffer (patcher-project-process-buffer project))
 210           sources
 211           change-logs)
 212   ;; Diff PROJECT's specification and deduce source and ChangeLog files.
 213   ;; Return 2 values: the lists of involved source and ChangeLog files.
 214   (patcher-save-sources project)
 215   (patcher-save-change-logs project)
 216   (patcher-diff project (patcher-command project
 217                           (patcher-project-diff-command project)
 218                           (patcher-project-specification project)))
 219   (setq sources (patcher-sources buffer))
 220   (unless sources
 221     (patcher-error "Your source files do not differ from the archive."))
 222   (when (patcher-project-option project :change-logs-updating)
 223     (patcher-with-progression "Detecting ChangeLog files"
 224       ;; Note that while we can rely on the diff to deduce the source files,
 225       ;; this is not possible for ChangeLog files, even when the updating is
 226       ;; manual, because they might not be there (for instance if
 227       ;; `specification' is explicit about files). So all in all, the only
 228       ;; safe way to deduce ChangeLog files is to compute them from the source
 229       ;; diffs.
 230       (dolist (source sources)
 231         (let ((change-log (patcher-locate-change-log project source)))
 232           (unless (member change-log change-logs)
 233             (patcher-endpush change-log change-logs))))))
 234   (values sources change-logs))
 235
 236
 237
 238 \f
 239 ;; ==========================================================================
 240 ;; Diff insertion
 241 ;; ==========================================================================
 242
 243 (globally-declare-boundp 'font-lock-always-fontify-immediately)
 244
 245 (put 'patcher-insert-diff 'lisp-indent-function 1)
 246 (defun* patcher-insert-diff
 247     (project point &optional (kind :sources)
 248                    &aux (buffer (patcher-project-process-buffer project))
 249                         (function (patcher-project-option project
 250                                     :diff-prologue-function)))
 251   ;; Insert PROJECT's diff at POINT in current buffer.
 252   ;; The diff comes from the process buffer and can be of different KINDs:
 253   ;; - :sources (the default) means to filter out only source diffs,
 254   ;; - :change-logs means to filter out only ChangeLog diffs,
 255   ;; - :mixed means to keep both (the whole process buffer is used here).
 256   ;; Prepend the diff with an appropriate prologue.
 257   ;; Depending on KIND, create a patcher-diff or patcher-change-logs extent
 258   ;; around insertion.
 259   (save-excursion
 260     (goto-char point)
 261     (when function
 262       (funcall function
 263                (patcher-project-command-name project)
 264                kind
 265                :source-files (patcher-project-sources-string project)
 266                :change-log-files (patcher-project-change-logs-string project)
 267                :source-diff (patcher-command project
 268                               (patcher-project-diff-command project))
 269                :change-log-diff (patcher-command project
 270                                   (patcher-project-option project
 271                                     :change-logs-diff-command))))
 272     (let ((font-lock-always-fontify-immediately t))
 273       (insert (ecase kind
 274                 (:sources
 275                  (patcher-source-contents buffer))
 276                 (:change-logs
 277                  (patcher-change-log-contents buffer))
 278                 (:mixed
 279                  (buffer-substring nil nil buffer)))))
 280     (set-extent-properties (make-extent point (point))
 281                            `(start-open t
 282                              duplicable t
 283                              ,(if (eq kind :change-logs)
 284                                   'patcher-change-logs
 285                                   'patcher-diff) t))))
 286
 287
 288 (provide 'patcher-diff)
 289
 290 ;;; patcher-diff.el ends here