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&gt; * 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&gt; _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches