;;; patch.el --- mail/apply a patch ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. ;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA ;;;; 02111-1307 USA ;;; Author: Thien-Thi Nguyen ;;; Version: 1 ;;; Favorite-Favorite: Favorite-Favorite ;;; Commentary: ;; This file has two symmetrical usage modes, for patch creation and ;; application, respectively. The details are somewhat tuned for Guile ;; maintenance; probably we should generalize it a bit and add it to ;; Emacs proper at some point in the future. Long live free software! ;; ;; On the patch creation side of things, there are various version ;; control systems that are happy to write a diff to stdout (and ;; numerous Emacs interfaces to them all). Thus, we provide only a ;; simple `patch-send' that composes mail from the current buffer; ;; the contents of that buffer are left as an exercise for the patch ;; creator. When preparing the mail, `patch-send' scans the patch ;; for standard filename headers and sets up a skeleton change log -- ;; filling this in is a good way to earn respect from maintainers (hint ;; hint). Type `C-c C-c' to send the mail when you are done. (See ;; `compose-mail' for more info.) ;; ;; TODO: Write/document patch-apply side of things. ;; TODO: Integrate w/ `ediff-patch-buffer' et al. ;;; Code: (require 'cl) (require 'update-changelog) ; for stitching ;; outgoing (defvar patch-greeting "hello guile maintainers,\n\n" "*String to insert at beginning of patch mail.") (defun patch-scan-files () (let (files) (save-excursion (while (re-search-forward "^[+][+][+] \\(\\S-+\\)" (point-max) t) (setq files (cons (cons (match-string 1) (match-beginning 0)) files)))) (reverse files))) (defun patch-common-prefix (filenames) (let* ((first-file (car filenames)) (prefix (and first-file (file-name-directory first-file)))) (while (and prefix (not (string= "" prefix)) (not (every (lambda (filename) (string-match (concat "^" prefix) filename)) filenames))) (setq prefix (file-name-directory (substring prefix 0 -1)))) prefix)) (defun patch-changelog-skeleton () (let* ((file-info (patch-scan-files)) (fullpath-files (mapcar 'car file-info)) (cut (length (patch-common-prefix fullpath-files))) (files (mapcar (lambda (fullpath-file) (substring fullpath-file cut)) fullpath-files))) (mapconcat (lambda (file) (concat (make-string (length file) ?_) "\n" file "\n[writeme]")) files "\n"))) (defun patch-send (buffer subject) (interactive "bBuffer: \nsSubject: ") (when (string= "" subject) (error "(empty subject)")) (compose-mail "bug-guile@gnu.org" subject) (insert (with-current-buffer buffer (buffer-string))) (mail-text) (insert patch-greeting) (save-excursion (insert "here is a patch ... [overview/observations/etc]\n\n" (patch-changelog-skeleton) "\n\n\n" (make-string 72 ?_) "\n"))) ;; incoming ;;; patch.el ends here