emacs/patch.el

   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