| 1 | ;;; patch.el --- mail/apply a patch |
| 2 | |
| 3 | ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;;;; This library is free software; you can redistribute it and/or |
| 6 | ;;;; modify it under the terms of the GNU Lesser General Public |
| 7 | ;;;; License as published by the Free Software Foundation; either |
| 8 | ;;;; version 3 of the License, or (at your option) any later version. |
| 9 | ;;;; |
| 10 | ;;;; This library is distributed in the hope that it will be useful, |
| 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 13 | ;;;; Lesser General Public License for more details. |
| 14 | ;;;; |
| 15 | ;;;; You should have received a copy of the GNU Lesser General Public |
| 16 | ;;;; License along with this library; if not, write to the Free |
| 17 | ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
| 18 | ;;;; 02111-1307 USA |
| 19 | |
| 20 | ;;; Author: Thien-Thi Nguyen <ttn@gnu.org> |
| 21 | ;;; Version: 1 |
| 22 | ;;; Favorite-Favorite: Favorite-Favorite |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; This file has two symmetrical usage modes, for patch creation and |
| 27 | ;; application, respectively. The details are somewhat tuned for Guile |
| 28 | ;; maintenance; probably we should generalize it a bit and add it to |
| 29 | ;; Emacs proper at some point in the future. Long live free software! |
| 30 | ;; |
| 31 | ;; On the patch creation side of things, there are various version |
| 32 | ;; control systems that are happy to write a diff to stdout (and |
| 33 | ;; numerous Emacs interfaces to them all). Thus, we provide only a |
| 34 | ;; simple `patch-send' that composes mail from the current buffer; |
| 35 | ;; the contents of that buffer are left as an exercise for the patch |
| 36 | ;; creator. When preparing the mail, `patch-send' scans the patch |
| 37 | ;; for standard filename headers and sets up a skeleton change log -- |
| 38 | ;; filling this in is a good way to earn respect from maintainers (hint |
| 39 | ;; hint). Type `C-c C-c' to send the mail when you are done. (See |
| 40 | ;; `compose-mail' for more info.) |
| 41 | ;; |
| 42 | ;; TODO: Write/document patch-apply side of things. |
| 43 | ;; TODO: Integrate w/ `ediff-patch-buffer' et al. |
| 44 | |
| 45 | ;;; Code: |
| 46 | |
| 47 | (require 'cl) |
| 48 | (require 'update-changelog) ; for stitching |
| 49 | |
| 50 | ;; outgoing |
| 51 | |
| 52 | (defvar patch-greeting "hello guile maintainers,\n\n" |
| 53 | "*String to insert at beginning of patch mail.") |
| 54 | |
| 55 | (defun patch-scan-files () |
| 56 | (let (files) |
| 57 | (save-excursion |
| 58 | (while (re-search-forward "^[+][+][+] \\(\\S-+\\)" (point-max) t) |
| 59 | (setq files (cons (cons (match-string 1) |
| 60 | (match-beginning 0)) |
| 61 | files)))) |
| 62 | (reverse files))) |
| 63 | |
| 64 | (defun patch-common-prefix (filenames) |
| 65 | (let* ((first-file (car filenames)) |
| 66 | (prefix (and first-file (file-name-directory first-file)))) |
| 67 | (while (and prefix |
| 68 | (not (string= "" prefix)) |
| 69 | (not (every (lambda (filename) |
| 70 | (string-match (concat "^" prefix) filename)) |
| 71 | filenames))) |
| 72 | (setq prefix (file-name-directory (substring prefix 0 -1)))) |
| 73 | prefix)) |
| 74 | |
| 75 | (defun patch-changelog-skeleton () |
| 76 | (let* ((file-info (patch-scan-files)) |
| 77 | (fullpath-files (mapcar 'car file-info)) |
| 78 | (cut (length (patch-common-prefix fullpath-files))) |
| 79 | (files (mapcar (lambda (fullpath-file) |
| 80 | (substring fullpath-file cut)) |
| 81 | fullpath-files))) |
| 82 | (mapconcat |
| 83 | (lambda (file) |
| 84 | (concat (make-string (length file) ?_) "\n" file "\n[writeme]")) |
| 85 | files |
| 86 | "\n"))) |
| 87 | |
| 88 | (defun patch-send (buffer subject) |
| 89 | (interactive "bBuffer: \nsSubject: ") |
| 90 | (when (string= "" subject) |
| 91 | (error "(empty subject)")) |
| 92 | (compose-mail "bug-guile@gnu.org" subject) |
| 93 | (insert (with-current-buffer buffer (buffer-string))) |
| 94 | (mail-text) |
| 95 | (insert patch-greeting) |
| 96 | (save-excursion |
| 97 | (insert "here is a patch ... [overview/observations/etc]\n\n" |
| 98 | (patch-changelog-skeleton) "\n\n\n" |
| 99 | (make-string 72 ?_) "\n"))) |
| 100 | |
| 101 | ;; incoming |
| 102 | |
| 103 | |
| 104 | |
| 105 | |
| 106 | ;;; patch.el ends here |