[PATCH] Supporting removed files in patcher, part 2.
This is the second of two patches that allows patcher to handle removed
files. This patch makes changes to patcher.el
In addition to the problems with removed files that patcher.el shares in
common with add-log.el, patcher also incorrectly removes the leading '/'
from /dev/null when cleaning up mercurial patches. This patch
explicitly removes '/a' and '/b', instead of '/' and the next
character,
from such files.
Malcolm
ChangeLog addition:
2008-04-29 Malcolm Purvis <malcolmp(a)xemacs.org>
* patcher.el (patcher-parse-region):
* patcher.el (patcher-hg-diff-convert):
* patcher.el (patcher-diff-base): Understand patches that have
removed files.
lisp-xemacs-devel source patch:
Diff command: cvs -q diff -u
Files affected: patcher.el
===================================================================
RCS
Index: patcher.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-devel/patcher.el,v
retrieving revision 1.25
diff -u -r1.25 patcher.el
--- patcher.el 2008/02/27 17:59:10 1.25
+++ patcher.el 2008/04/29 13:07:42
＠＠ -1802,6 +1802,7 ＠＠
(with-current-buffer (or buffer (current-buffer))
(let ((file-re1 "^Index: \\(\\S-*\\)");; for archive diff
(file-re "^\\+\\+\\+ \\(\\S-*\\)");; for standard diff
+ (removed-file-re "^--- \\(\\S-*\\)");; for standard diff
(basename-re "\\`\\(.*\\)/\\(.*\\)\\'")
(min (or min (point-min)))
(max (or max (point-max)))
＠＠ -1812,6 +1813,12 ＠＠
(and (re-search-forward file-re1 max t)
(setq file-re file-re1)))
(while (re-search-forward file-re max t)
+ ;; If a file has been removed then the first match will be
+ ;; /dev/null. Go back one line and find the real file.
+ (if (string= (match-string 1) "/dev/null")
+ (save-excursion
+ (forward-line -1)
+ (re-search-forward removed-file-re max t)))
(setq file (match-string 1))
(if (string-match basename-re file)
(setq dirname (match-string 1 file))
＠＠ -1822,6 +1829,10 ＠＠
(and (re-search-forward file-re max t)
(point-at-bol)))
max))
+ ;; If the directory doesn't exist then search for the parent that
+ ;; does.
+ (while (not (file-exists-p dirname))
+ (setq dirname (directory-file-name (concat (file-name-directory dirname)))))
(setq change-log
(with-temp-buffer
(cd (expand-file-name dirname default-directory))
＠＠ -2013,9 +2024,10 ＠＠
(goto-char (or beg (point-min)))
(while (re-search-forward "^\\(---\\|\\+\+\\+\\) " end t)
(setq beg (point))
- (skip-chars-forward "^/")
- (forward-char 1)
- (delete-region beg (point))))
+ (let* ((send (+ beg 10)) ; Don't look far for 'a/' or 'b/'.
+ (dend (if end (min end send) send)))
+ (if (re-search-forward "\\(a\\|b\\)/" dend t)
+ (delete-region beg (point))))))
(defun patcher-run-after-diff-hook (buffer &optional beg end)
;; If any, call the after-diff hooks on BUFFER (auxiliary or mail
＠＠ -2246,8 +2258,13 ＠＠
(patcher-map-source-extents buffer
(let* ((file (extent-property extent 'patcher-source))
(change-log (with-temp-buffer
- (cd (file-name-directory file))
- (find-change-log))))
+ (let ((dirname (file-name-directory file)))
+ ;; If the directory doesn't exist then search for
+ ;; the parent that does.
+ (while (not (file-exists-p dirname))
+ (setq dirname (directory-file-name (concat (file-name-directory dirname)))))
+ (cd dirname)
+ (find-change-log)))))
(unless (assoc change-log patcher-change-logs)
(push (cons change-log (not (get-file-buffer change-log)))
patcher-change-logs))))))
--
Malcolm Purvis <malcolmp(a)xemacs.org>
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches