mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
53befeb700
(Not quite finished, the following will be done tomorrow. module/srfi/*.scm module/rnrs/*.scm module/scripts/*.scm testsuite/*.scm guile-readline/* )
106 lines
3.8 KiB
EmacsLisp
106 lines
3.8 KiB
EmacsLisp
;;; 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 <ttn@gnu.org>
|
|
;;; 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
|