Source

patcher / lisp / patcher.el

;;; patcher.el --- Utility for mailing patch information

;; Copyright (C) 2008, 2009, 2010, 2011 Didier Verna
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Didier Verna

;; Author:        Didier Verna <didier@xemacs.org>
;; Maintainer:    Didier Verna <didier@xemacs.org>
;; Created:       Tue Sep 28 18:12:43 1999
;; Last Revision: Thu Jan 12 22:17:28 2012
;; Keywords:      maint


;; This file is part of Patcher.

;; Patcher is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License version 3,
;; as published by the Free Software Foundation.

;; Patcher 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 General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


;;; Commentary:

;; Contents management by FCM version 0.1.

;; Patcher is an XEmacs package designed to automate and ease the
;; maintenance of archive-based projects.  It provides assistance in
;; building, reporting and committing patches, as well as in handling the
;; corresponding ChangeLog entries, for example by creating skeletons.

;; Patcher is fully documented.  Please refer to the documentation for
;; information on how to use it.  All user options can be found in the
;; "Patcher" Custom group.


;; Suggestions for further improvements:

;; #### Maybe we could send mails without even a diff in them (because RCSes
;; are configured to send mails by themselves) in which case we just send a
;; mail with some information regarding the patch.

;; patcher-compress-change-logs doesn't do a very good job, especially wrt
;; indentation.

;; #### Add support for interactive RCSes (hmpf !). For instance, it would be
;; neat to answer darcs questions interactively, and then construct the patch
;; and the changelogs only for the selected patches.

;; #### Add an "identity" project option (more than just the
;; change-logs-user-[name|mail]. Some RCSes like hg may use it for commit
;; information.

;; #### Investigate on the notion of adding new files (it's different across
;; RCSes).

;; #### The subject-related strings could benefit from almost all %
;; constructs.

;; #### Provide a way to attach patches instead of inserting them as plain
;; text in mail buffers.

;; #### Provide a way to filter out some files from the mailed patch.  For
;; instance, when you commit yourself, you want to have `configure' in your
;; files, but you don't want to display a patch against it.

;; #### Complete the error mechanism.

;; #### When a project is found to be out of date, we could implement
;; something to update it and re-run patcher again.

;; #### For the 'gnus mail method, add the possibility to temporarily use a
;; different one if the user don't want to start Gnus.

;; #### Also add an option to kill, not just bury, the mail message when
;; it's sent. In fact, no because that should depend on the MUA. Except for
;; the fake mail method of course.

;; #### Have a control window to clarify the progress of everything.
;; Make it perhaps a small buffer, above the mail message/ChangeLog
;; buffer.  It shows what steps have been completed, what haven't, and
;; what to do.  It should have buttons in it for the various actions.
;; One button is for include-changelogs, one for commit, one for send
;; the mail, and one for execute the commit.  These should be enabled
;; or grayed out appropriately.  It should also have buttons that show
;; the associated changelogs; clicking on a button puts that changelog
;; buffer in the main window below the control window.  By each
;; changelog button should be an indication of whether the changelog
;; has been modified so far.  The control window should stay around as
;; much as it can during the whole process (e.g. use
;; set-buffer-dedicated-p or something), so that it's always there to
;; drive the whole process.  One corollary is that you don't actually
;; have to switch to the mail buffer to (e.g.) execute
;; include-changelogs -- you just click on the control window, and it
;; does it automatically.  also, when you execute include-changelogs,
;; it can issue a warning if not all changelogs have been visited, and
;; prompt you to make sure you want to continue.  Similarly, you can
;; run include-changelogs more than once even if it succeeded the
;; first time (e.g. for some reason you didn't like the result and
;; deleted it), but it will prompt "are you sure?".  There could also
;; be an "undo include-changelogs", if you make a mistake after doing
;; include-changelogs and realize you want to go back and fix the
;; problem and do include-changelogs again.


;; Thanks to these people for their suggestions, testing and contributions:
;; Adrian Aichner, Ben Wing, Karl Pflasterer, Malcolm Purvis, Norbert Koch,
;; Raphael Poss, Stephen J. Turnbull, Steve Youngs.


;;; Code:

(require 'cl)

(eval-when-compile (require 'patcher-cutil))
(require 'patcher-util)
(require 'patcher-face)
(require 'patcher-project)
(require 'patcher-instance)
(require 'patcher-source)
(require 'patcher-change-log)
(require 'patcher-diff)
(require 'patcher-cmtcmd)
(require 'patcher-logmsg)
(require 'patcher-mail)



;; ===========================================================================
;; Version management
;; ===========================================================================

(defconst patcher-version "4.0 pre 1"
  "Current version of Patcher.")

;;;###autoload
(defun patcher-version ()
  "Show the current version of Patcher."
  (interactive)
  (message "Patcher version %s" patcher-version))




;; ===========================================================================
;; Built-in themes
;; ===========================================================================

(defun patcher-git-intent-to-add (file)
  "Signal our intention to add FILE to the Git index (add -N)."
  (let ((dir default-directory))
    (with-temp-buffer
      (cd dir)
      (patcher-call-process (concat "git add -N -- " file)))))

(defun* patcher-git-add
  (&aux (file (patcher-file-relative-name (buffer-file-name))))
  "Add the current buffer's file to the Git index."
  (with-temp-buffer
    (patcher-call-process (concat "git add -- " file))))

(defun* patcher-git-detect-submodules
    (directory &aux (gitmodules (expand-file-name ".gitmodules" directory)))
  ;; Detect Git submodules in DIRECTORY.
  (when (file-exists-p gitmodules)
    (with-temp-buffer
      (insert-file-contents-literally gitmodules)
      (goto-char (point-min))
      (let (submodules)
	;; #### WARNING: what about spaces in file names ?
	(while (re-search-forward
		"\
^\\[submodule[ \t]+\"\\(.+\\)\"\\]\n\
[ \t]*path[ \t]*=[ \t]*\\(.+\\)$"
 nil t)
	  (push (list (match-string 1)
		      (match-string 2))
		submodules))
	submodules))))

(defun* patcher-hg-detect-submodules
    (directory &aux (hgsub (expand-file-name ".hgsub" directory)))
  ;; Detect Mercurial submodules in DIRECTORY.
  (when (file-exists-p hgsub)
    (with-temp-buffer
      (insert-file-contents-literally hgsub)
      (goto-char (point-min))
      (let (submodules)
	;; #### WARNING: what about spaces in file names ?
	(while (re-search-forward "^\\(.+\\)[ \t]+=.+$" nil t)
	  (push (list (file-name-nondirectory (match-string 1))
		      (match-string 1))
		submodules))
	submodules))))

(setq patcher-built-in-themes
      '((git-index-automatic-change-logs
	 :link-change-log-hook (patcher-git-intent-to-add)
	 ;; #### NOTE: we can't use the link-change-log hook to git-add a
	 ;; ChangeLog file, because adding an unmodified file is a no op. So
	 ;; we need to use the after-save hook to do that.
	 :after-save-change-log-hook (patcher-git-add))
	(git-index-ws
	 :diff-command
	 "git diff -b -w -M --relative --no-prefix --cached%?f{ -- }%f"
	 :change-logs-diff-command
	 "git diff -b -w -U0 --relative --no-prefix --cached%?f{ -- }%f"
	 :themes (git-index ws))
	(git-index
	 :diff-command
	 "git diff -M --relative --no-prefix --cached%?f{ -- }%f"
	 :change-logs-diff-command
	 "git diff -U0 --relative --no-prefix --cached%?f{ -- }%f"
	 :commit-command "git commit -F %s"
	 :themes (git))
	(git-ws
	 :diff-command
	 "git diff -b -w --relative --no-prefix HEAD%?f{ -- }%f"
	 :change-logs-diff-command
	 "git diff -b -w -U0 --relative --no-prefix HEAD%?f{ -- }%f"
	 :themes (git ws))
	(git
	 :diff-header ("\
^diff .*\n\
\\(\\(deleted file\\|new file\\).*\n\\)?\
\\(similarity \\)?index .*\n\
\\(--- \\|rename from \\)\\(\\S-+\\).*\n\
\\(\\+\\+\\+ \\|rename to \\)\\(\\S-+\\).*"
		       5 7)
	 :diff-command
	 "git diff --relative --no-prefix HEAD%?f{ -- }%f"
	 :change-logs-diff-command
	 "git diff -U0 --relative --no-prefix HEAD%?f{ -- }%f"
	 :commit-command "git commit %!f{-a }-F %s%?f{ -- }%f"
	 :submodule-detection-function patcher-git-detect-submodules)
	(mercurial-ws
	 :diff-command "hg diff --git --show-function -wbB %f"
	 :change-logs-diff-command "hg extdiff -o -wbBtU0 %f"
	 :themes (mercurial ws))
	(mercurial
	 :diff-header ("\
^diff .*\n\
\\(\\(deleted file\\|new file\\).*\n\\)?\
\\(--- \\(a/\\)?\\|rename from \\|copy from \\)\\(\\S-+\\).*\n\
\\(\\+\\+\\+ \\(b/\\)?\\|rename to \\|copy to \\)\\(\\S-+\\).*"
		       5 8)
	 :diff-command "hg diff --git --show-function %f"
	 :change-logs-diff-command "hg extdiff -o -U0 %f"
	 :commit-command "hg commit --logfile %s %f"
	 :submodule-detection-function patcher-hg-detect-submodules)
	(darcs-ws
	 :diff-command "darcs diff --diff-opts -uwbBt %f"
	 :change-logs-diff-command "darcs diff --diff-opts -wbBtU0 %f"
	 :themes (darcs ws))
	(darcs
	 :diff-command "darcs diff -u %f"
	 :diff-header ("\
^diff .*\n\
--- old-.*?/\\(.*?\\)\t.*\n\
\\+\\+\\+ new-.*?/\\(.*?\\)\t.*"
		       1 2)
	 :change-logs-diff-command "darcs diff --diff-opts -U0 %f"
	 :commit-command "darcs record -a --logfile %s --delete-logfile %f"
	 :failed-command-regexp "^darcs failed:")
	(svn-ws
	 :diff-command "svn diff -x -uwb %f"
	 :change-logs-diff-command
	 "svn diff --diff-cmd /usr/bin/diff -x -wbBtU0 %f"
	 :themes (svn ws))
	(svn
	 :diff-header ("\
^Index: \\(.\\|\n\\)+?\n\
--- \\(.*?\\)\t.*\n\
\\+\\+\\+ \\(.*?\\)\t.*"
		       2 3)
	 :diff-command "svn diff -x -u %f"
	 :change-logs-diff-command
	 "svn diff --diff-cmd /usr/bin/diff -x -U0 %f"
	 :commit-command "svn commit -F %s %f")
	(cvs-ws
	 :diff-command "cvs -q diff -uwbBt %f"
	 :change-logs-diff-command "cvs -q diff -wbBtU0 %f"
	 :themes (cvs ws))
	(cvs
	 :diff-header ("\
^Index: \\(.\\|\n\\)+?\n\
--- \\(.*?\\)\t.*\n\
\\+\\+\\+ \\(.*?\\)\t.*"
		       2 3)
	 :diff-line-filter "\\? .*"
	 :diff-command "cvs -q diff -u %f"
	 :ignore-diff-status t
	 :change-logs-diff-command "cvs -q diff -U0 %f"
	 :commit-command "cvs commit -F %s %f"
	 :failed-command-regexp "^cvs \\[[^]]* aborted\\]")
	(prcs-ws
	 :diff-command "prcs diff -f -P %n %f -- -uwbBt"
	 :change-logs-diff-command "prcs diff -f -P %n %f -- -wbBtU0"
	 :themes (prcs ws))
	(prcs
	 :diff-command "prcs diff -f -P %n %f -- -u"
	 :diff-header ("\
^Index: .*\n\
--- \\(.*?\\)/\\(\\S-+\\) .*\n\
\\+\\+\\+ \\(.*?\\)/\\(\\S-+\\) .*"
		       2 4)
	 :change-logs-diff-command "prcs diff -f -P %n %f -- -U 0"
	 :commit-command "prcs checkin -f --version-log=%S %n %f"
	 :failed-command-regexp "^prcs: Command failed.")
	(ws
	 :committed-notice "\
NOTE: This patch has been committed. The version below is informational only.
In particular, whitespace difference have been removed.")
	(ephemeral-change-logs
	 :change-logs-status ephemeral
	 :change-logs-prologue "ChangeLog entries:")))


(provide 'patcher)

;;; patcher.el ends here