Commit | Line | Data |
---|---|---|
88463d07 TTN |
1 | ;;; patch.el --- mail/apply a patch |
2 | ||
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
5 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
6 | ;; it under the terms of the GNU General Public License as published by | |
7 | ;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;; any later version. | |
9 | ||
10 | ;; GNU Emacs 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 | |
13 | ;; GNU General Public License for more details. | |
14 | ||
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
17 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
18 | ;; Boston, MA 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 | |
ebc43ccb | 34 | ;; simple `patch-send' that composes mail from the current buffer; |
88463d07 | 35 | ;; the contents of that buffer are left as an exercise for the patch |
ebc43ccb | 36 | ;; creator. When preparing the mail, `patch-send' scans the patch |
88463d07 TTN |
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 | ||
49 | (defvar patch-greeting "hello guile maintainers,\n\n" | |
50 | "*String to insert at beginning of patch mail.") | |
51 | ||
52 | (defun patch-scan-files () | |
53 | (let (files) | |
54 | (save-excursion | |
55 | (while (re-search-forward "^[+][+][+] \\(\\S-+\\)" (point-max) t) | |
56 | (setq files (cons (cons (match-string 1) | |
57 | (match-beginning 0)) | |
58 | files)))) | |
59 | (reverse files))) | |
60 | ||
61 | (defun patch-common-prefix (filenames) | |
62 | (let* ((first-file (car filenames)) | |
63 | (prefix (and first-file (file-name-directory first-file)))) | |
64 | (while (and prefix | |
65 | (not (string= "" prefix)) | |
66 | (not (every (lambda (filename) | |
67 | (string-match (concat "^" prefix) filename)) | |
68 | filenames))) | |
69 | (setq prefix (file-name-directory (substring prefix 0 -1)))) | |
70 | prefix)) | |
71 | ||
72 | (defun patch-changelog-skeleton () | |
73 | (let* ((file-info (patch-scan-files)) | |
74 | (fullpath-files (mapcar 'car file-info)) | |
75 | (cut (length (patch-common-prefix fullpath-files))) | |
76 | (files (mapcar (lambda (fullpath-file) | |
77 | (substring fullpath-file cut)) | |
78 | fullpath-files))) | |
79 | (mapconcat | |
80 | (lambda (file) | |
81 | (concat (make-string (length file) ?_) "\n" file "\n[writeme]")) | |
82 | files | |
83 | "\n"))) | |
84 | ||
ebc43ccb | 85 | (defun patch-send (buffer subject) |
88463d07 TTN |
86 | (interactive "bBuffer: \nsSubject: ") |
87 | (when (string= "" subject) | |
88 | (error "(empty subject)")) | |
89 | (compose-mail "bug-guile@gnu.org" subject) | |
90 | (insert (with-current-buffer buffer (buffer-string))) | |
91 | (mail-text) | |
92 | (insert patch-greeting) | |
93 | (save-excursion | |
94 | (insert "here is a patch ... [overview/observations/etc]\n\n" | |
95 | (patch-changelog-skeleton) "\n\n\n" | |
96 | (make-string 72 ?_) "\n"))) | |
97 | ||
98 | ;;; patch.el ends here |