Commits

Anonymous committed a70fd30

add patcher to xemacs-devel, many improvements to it; minor docref.el fix

Comments (0)

Files changed (4)

+2001-04-10  Ben Wing  <ben@xemacs.org>
+
+	* patcher.el: New file.
+	Written by Didier Verna, with various improvements from Adrian
+	Aichner and me.  Latest improvements:
+
+	-- add variables for default values of command, options
+	-- change keystroke from M-p i to C-c C-p i, as per Didier's
+	   accord
+	-- add new command to commit the change, prompting for a log
+	   message (derived from the subject of the patch message);
+	   bound to C-c C-p c
+	-- fix up a lot of the documentation
+	-- output messages at each step indicating the next step
+	-- rename patcher-minor-mode-hooks -> patcher-minor-mode-hook
+	
+	* Makefile (ELCS): Add patcher.elc.
+	* docref.el: Use correct name for hook.
+
 2000-12-12  Martin Buchholz  <martin@xemacs.org>
 
 	* profile.el (profile-results): Prettier pretty-printing.
 
 ELCS = bench.elc checkdoc.elc docref.elc eldoc.elc elp.elc eval-expr.elc \
 	find-func.elc find-gc.elc hide-copyleft.elc ielm.elc \
-	lisp-file-db.elc profile.elc pretty-print.elc reposition.elc \
-	trace.elc
+	lisp-file-db.elc patcher.elc profile.elc pretty-print.elc \
+	reposition.elc trace.elc 
 
 include ../../XEmacs.rules
 
   (setq major-mode 'docref-mode)
   (setq mode-name "Docref")
   (use-local-map docref-mode-map)
-  (run-hooks 'docref-mode))
+  (run-hooks 'docref-mode-hook))
 
 (defun docref-subst (buf)
   "Parse documentation cross-references in buffer BUF.
+;;; patcher.el --- Utility for mailing patch information
+
+;; Copyright (C) 1999-2000 Didier Verna.
+
+;; Author:        Didier Verna <didier@xemacs.org>
+;; Maintainer:    Didier Verna <didier@xemacs.org>
+;; Created:       Tue Sep 28 18:12:43 1999
+;; Last Revision: Tue Jun 20 09:53:21 2000
+;; 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 as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; 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.
+
+;; This package automates the process of building and submitting patches for
+;; archive-based projects you're working on. In one or two keystrokes, it
+;; prepares a mail with a patch corresponding to the differences between your
+;; working version and the archive state, and prepares a skeleton for the
+;; ChangeLog entries, that you can fill in and insert into the message before
+;; sending.
+
+;; Patcher currently supports the `compose-mail' mail sending interface, as
+;; well as the `sendmail' and `message' libraries individually, which is
+;; probably redundant. There is also a special support for sending mail from a
+;; running Gnus session.
+
+;; Here's a typical usage:
+
+;; 0/ After loading the package, customize the group `patcher' to suit your
+;;    needs.
+;; 1/ Once you have made modifications to one of your projects and you'd like
+;;    to submit them, type `M-x patcher-mail' (see the docstring). The message
+;;    will be prepared and the ChangeLog skeletons built.
+;; 3/ Edit the different ChangeLog buffers that have opened, and fill in the
+;;    skeletons. You can save the ChangeLogs buffers, BUT DON't KILL THEM !!
+;; 4/ Return to the message buffer, and type `C-c C-p i'. The new ChangeLog
+;;    entries will be inserted just above the patch.
+;; 5/ That's all folks. Now, you can kill the buffers.
+
+;; Requirements:
+
+;; This package requires a recent `add-log' library. The different mail
+;; methods will also have specific requirements (especially the Gnus one).
+;; Please, refer to them for further information.
+
+
+;;; Code:
+
+(eval-when (eval load)
+  (require 'add-log)
+  )
+
+;; Customizable part =========================================================
+
+(defgroup patcher nil
+  "Patch mailing utilities.")
+
+(defcustom patcher-mail-method 'compose-mail
+  "*Method used to prepare a patch-related mail with `patcher-mail'.
+Currently, there are four built in methods: `compose-mail' (the
+default), `sendmail', `message' and `gnus'.  Please refer to the
+corresponding `patcher-mail-*' function for a description of each
+method.
+
+You can also define your own method, say `foo'.  In that case, you
+*must* provide a function named `patcher-mail-foo' which takes two
+arguments: A project descriptor and a string containing the subject of
+the message.  This function must prepare a mail buffer.  If you want
+to do this, please see how it's done for the built in methods."
+  :group 'patcher
+  :type '(choice (const :value compose-mail)
+		 (const :value sendmail)
+		 (const :value message)
+		 (const :value gnus)
+		 (symbol :tag "other")))
+
+;; If you are using the `cvs-diff' script from http://www.666.com/xemacs/,
+;; a good value might be "cvs-diff -no-changelog", or
+;; "bash -ci \"cvs-diff -no-changelog\"" under MS Windows (because the #!
+;; syntax is not recognized by CMD.EXE).
+
+(defcustom patcher-default-diff-command "cvs diff"
+  "*Default diff command used to prepare a patch using `patcher-mail'.
+See `patcher-projects' for more information."
+  :group 'patcher
+  :type 'string)
+
+(defcustom patcher-commit-command "cvs commit -F %s"
+  "*Command used to commit (check in) a patch after `patcher-mail' is run.
+The command should contain a `%s', which will be replaced by the name of
+a file containing the log message.  See `patcher-commit-change'."
+  :group 'patcher
+  :type 'string)
+
+(defcustom patcher-default-options
+  '((to-address . "xemacs-patches@xemacs.org"))
+  "*Default options used to prepare a patch using `patcher-mail'.
+See `patcher-projects' for more information."
+  :group 'patcher
+  :type '(repeat :tag "Options"
+		 (choice
+		  :value (mail-prologue . "")
+		  (cons :tag "Mail Prologue" :format "%{%t%}: %v"
+			(const :tag "" :value mail-prologue)
+			(string :tag "Value"))
+		  (cons :tag "To Address" :format "%{%t%}: %v"
+			(const  :tag "" :value to-address)
+			(string :tag "Value"))
+		  (cons :tag "Gnus Group" :format "%{%t%}: %v"
+			(const  :tag "" :value gnus-group)
+			(string :tag "Value"))
+		  (cons :tag "Other"
+			symbol
+			sexp))))
+
+(defcustom patcher-projects '()
+  "*List of project descriptors for use with `patcher-mail'.
+Each project descriptor looks like
+\(NAME DIR &optional DIFF ((OPTION . VALUE) ...)):
+- NAME is the project's name (it serves to identify the project),
+- DIR  is the top level directory where the project's sources live,
+- DIFF is the diff command to use in order to prepare a patch.
+  If nil or omitted, it defaults to the value in
+  `patcher-default-diff-command'.
+
+The remainder of the project descriptor is a list of options specific
+to the mailing method you want to use.  Defaults for the options are
+specified using `patcher-default-options'.
+
+The following options are common to all methods:
+
+- '(mail-prologue . STRING): If this option exists, it defines a short
+   piece of text that will be inserted at the beginning of messages.
+
+The following other options are currently recognized:
+
+- '(to-address . STRING) [for all values of `patcher-mail-method' other
+   than `gnus']: Email address for sending the message.  If not defined,
+   it is prompted for.
+- '(gnus-group . STRING) [when `patcher-mail-method' is `gnus']: Used as
+   a Gnus group name, as if you had typed `C-u a' in the group buffer.
+   If not defined, is prompted for.
+
+Please refer to the variable `patcher-mail-method' for more information."
+  :group 'patcher
+  :type '(repeat
+	  (group (string :tag "Project")
+		 (directory :tag "Project directory")
+		 (string :tag "Diff command")
+		 (repeat :tag "Options"
+			 (choice
+                          :value (mail-prologue . "")
+                          (cons :tag "Mail Prologue" :format "%{%t%}: %v"
+                                (const :tag "" :value mail-prologue)
+                                (string :tag "Value"))
+                          (cons :tag "To Address" :format "%{%t%}: %v"
+                                (const  :tag "" :value to-address)
+                                (string :tag "Value"))
+                          (cons :tag "Gnus Group" :format "%{%t%}: %v"
+                                (const  :tag "" :value gnus-group)
+                                (string :tag "Value"))
+                          (cons :tag "Other"
+                                symbol
+                                sexp))
+			 )))
+  )
+
+(defcustom patcher-keep-source-files nil
+  "*Whether to keep source files visited during `patcher-mail'.
+When ChangeLog skeletons are built by `patcher-mail', the
+corresponding source files are temporarily visited by XEmacs.  This
+variable lets you decide whether or not you want to preserve these
+buffers afterwards.  It might be useful to keep these files around for
+quick reference when you don't remember all the changes you've done."
+  :group 'patcher
+  :type 'boolean)
+
+;; Project descriptors Accessors:
+(defsubst patcher-project-name (project)
+  (nth 0 project))
+(defsubst patcher-project-directory (project)
+  (nth 1 project))
+(defsubst patcher-project-command (project)
+  (or (nth 2 project) patcher-default-diff-command))
+(defsubst patcher-project-option (project option)
+  (or (cdr (assoc option (nth 3 project)))
+      (cdr (assoc option patcher-default-options))))
+
+
+;; Internal variables ========================================================
+
+;; $Format: "(defconst patcher-prcs-major-version \"$ProjectMajorVersion$\")"$
+(defconst patcher-prcs-major-version "branch-0-1")
+;; $Format: "(defconst patcher-prcs-minor-version \"$ProjectMinorVersion$\")"$
+(defconst patcher-prcs-minor-version "3")
+(defconst patcher-version
+  (let ((level patcher-prcs-minor-version)
+	major minor status)
+    (string-match "\\(branch\\|version\\)-\\([0-9]+\\)-\\([0-9]+\\)"
+		  patcher-prcs-major-version)
+    (setq major (match-string 2 patcher-prcs-major-version)
+	  minor (match-string 3 patcher-prcs-major-version)
+	  status (match-string 1 patcher-prcs-major-version))
+    (cond ((string= status "version")
+	   (setq level (int-to-string (1- (string-to-int level))))
+	   (if (string-equal level "0")
+	       (concat major "." minor)
+	     (concat major "." minor "." level)))
+	  ((string= status "branch")
+	   (concat major "." minor "-b" level)))
+    ))
+
+(make-variable-buffer-local
+ (defvar patcher-change-logs nil
+   ;; List of ChangeLog file buffers affected by the current patch.
+   ))
+
+(make-variable-buffer-local
+ (defvar patcher-current-project nil
+   ;; Patcher project associated with the current buffer.
+   ))
+
+(make-variable-buffer-local
+ (defvar patcher-patch-marker nil
+   ;; Marker indicating the beginning of the patch
+   ))
+
+(defvar patcher-projects-history nil
+  ;; History used for prompting patcher projects.
+  )
+
+
+;; The Patcher minor-mode ====================================================
+
+(defcustom patcher-minor-mode-string " Patch"
+  "*String to use in the modeline when Patcher minor mode is active."
+  :group 'patcher
+  :type 'string)
+
+(defcustom patcher-minor-mode-hook nil
+  "*Hook to run after setting up Patcher minor mode."
+  :group 'patcher
+  :type 'hook)
+
+(defun patcher-insert-change-logs ()
+  "Insert annotated ChangeLog entries, after `patcher-mail' has been run.
+Run this command after you've run `patcher-mail' and then annotated the
+ChangeLog skeletons that were created."
+  (interactive)
+  (save-excursion
+    (goto-char patcher-patch-marker)
+    (let ((change-log-buffers patcher-change-logs)
+	  change-log-buffer)
+      (while (setq change-log-buffer (pop change-log-buffers))
+	(map-extents
+	 '(lambda (extent unused)
+            (let
+                ;; APA: Force forward slashes (for native Windows).
+                ((directory-sep-char ?/))
+              (message "%s %s" (extent-start-position extent)
+                       (extent-end-position extent))
+              (sit-for 1)
+              (insert
+               (format "%s addition:\n\n"
+                       (file-relative-name (buffer-file-name change-log-buffer)
+                                           (patcher-project-directory
+                                            patcher-current-project))))
+              (insert (extent-string extent))
+              ;; be sure to map all extents
+              nil))
+	 change-log-buffer nil nil nil nil 'patcher))
+      )))
+
+(defcustom patcher-logmsg-mode-hook nil
+  "*Hook to run after setting up Patcher-Logmsg mode."
+  :group 'patcher
+  :type 'hook)
+
+(defvar patcher-logmsg-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-c\C-c" 'patcher-logmsg-do-it)
+    map))
+
+(defvar patcher-logmsg-source-buffer)
+(defvar patcher-logmsg-window-config)
+
+(defun patcher-logmsg-do-it (command)
+  "Major mode for editing the log message for `patcher-commit-change'.
+To commit the change, use \\<patcher-logmsg-mode-map>\\[patcher-logmsg-do-it]."
+  (interactive (list (read-shell-command "Commit Command: "
+					 patcher-commit-command)))
+  (let ((name (replace-in-string
+	       (make-temp-name
+		(expand-file-name "patch" (temp-directory)))
+	       "\\\\" "/"))
+	(logout (get-buffer-create "*Patcher-Commit-Change-Output*"))
+	(winconf patcher-logmsg-window-config))
+    (write-region (point-min) (point-max) name nil 'silent)
+    (erase-buffer logout)
+    (shell-command (replace-in-string command "%s" name t) logout)
+    (kill-buffer (current-buffer))
+    (set-window-configuration winconf)
+    (if (buffer-live-p logout)
+	(display-buffer logout))))
+
+(defun patcher-logmsg-mode ()
+  "Major mode for editing the log message for `patcher-commit-change'.
+To commit the change, use \\<patcher-logmsg-mode-map>\\[patcher-logmsg-do-it]."
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'patcher-logmsg)
+  (setq mode-name "Patcher-Logmsg")
+  (use-local-map patcher-logmsg-mode-map)
+  (run-hooks 'patcher-logmsg-mode-hook))
+
+(defun patcher-commit-change ()
+  "Insert annotated ChangeLog entries, after `patcher-mail' has been run.
+Run this command after you've run `patcher-mail' and then annotated the
+ChangeLog skeletons that were created."
+  (interactive)
+    (let ((subject
+	   (save-excursion
+	     (goto-char (point-min))
+	     (and (re-search-forward
+		   "^Subject: \\(\\[PATCH\\]\\s-*\\)?\\(.*\\)$" nil t)
+		  (concat (match-string 2) "\n"))))
+	  (buf (generate-new-buffer "*Patcher-Log-Message*"))
+	  (curbuf (current-buffer))
+	  (winconf (current-window-configuration)))
+      (pop-to-buffer buf)
+      (patcher-logmsg-mode)
+      (and subject (insert subject))
+      (set (make-local-variable 'patcher-logmsg-window-config) winconf)
+      (set (make-local-variable 'patcher-logmsg-source-buffer) curbuf)
+      (message
+       (substitute-command-keys
+	"Enter log message.  Use \\[patcher-logmsg-do-it] when done."))))
+
+(defvar patcher-minor-mode-map
+  (let ((m (make-sparse-keymap 'patcher-minor-mode-map)))
+    (define-key m [(control c) (control p) i] 'patcher-insert-change-logs)
+    (define-key m [(control c) (control p) c] 'patcher-commit-change)
+    m)
+  ;; Patcher minor mode keymap
+  )
+
+(make-variable-buffer-local
+ (defvar patcher-minor-mode nil))
+
+(defun patcher-minor-mode (arg)
+  "Toggles Patcher minor mode.
+Used for mails prepared with `patcher-mail'. You're not supposed to use this,
+unless you know what you're doing."
+  (interactive "*P")
+  (setq patcher-minor-mode
+	(if (null arg) (not patcher-minor-mode)
+	  (> (prefix-numeric-value arg) 0)))
+  (run-hooks 'patcher-minor-mode-hook))
+
+(add-minor-mode
+ 'patcher-minor-mode patcher-minor-mode-string patcher-minor-mode-map)
+
+
+;; Mail preparation routines =================================================
+
+(defun patcher-mail-compose-mail (project subject)
+  "Prepare a patch-related mail with the `compose-mail' function.
+See also the `mail-user-agent' variable.
+
+If the option '(to-address . STRING) exists in the project descriptor
+PROJECT, its value is used as the email address for sending the message.
+Otherwise, it is prompted for."
+  (compose-mail (or (patcher-project-option project 'to-address)
+		    (read-string "To address: "))
+		subject))
+
+(eval-when (compile)
+  ;; Shut up the compiler.
+  (defun mail (arg1 arg2 arg3))
+  )
+(defun patcher-mail-sendmail (project subject)
+  "Prepare a patch-related mail with the `mail' function.
+This method requires the `sendmail' library.
+
+If the option '(to-address . STRING) exists in the project descriptor
+PROJECT, its value is used as the email address for sending the message.
+Otherwise, it is prompted for."
+  (require 'sendmail)
+  (mail nil (or (patcher-project-option project 'to-address)
+		(read-string "To address: "))
+		subject))
+
+
+(eval-when (compile)
+  ;; Shut up the compiler.
+  (defun message-mail (arg1 arg2))
+  )
+(defun patcher-mail-message (project subject)
+  "Prepare a patch-related mail with the `message-mail' function.
+This method requires the `message' library.
+
+If the option '(to-address . STRING) exists in the project descriptor
+PROJECT, its value is used as the email address for sending the message.
+Otherwise, it is prompted for."
+  (require 'message)
+  (message-mail (or (patcher-project-option project 'to-address)
+		    (read-string "To address: "))
+		    subject))
+
+(eval-when (compile)
+  ;; Shut up the compiler.
+  (defun gnus-alive-p ())
+  (defun gnus-post-news (arg1 arg2))
+  (defun message-goto-subject ())
+  (defun message-goto-body ())
+  )
+(defun patcher-mail-gnus (project subject)
+  "Prepare a patch-related mail with the `gnus-post-news' function.
+\(Don't worry, this function can also send mails ;-). This method requires
+that you have Gnus *running* in your XEmacs session.
+
+If the option '(gnus-group . STRING) exists in the project descriptor,
+its value is used as a Gnus group name, as if you had typed `C-u a' in
+the group buffer. Otherwise, it is prompted for."
+  (require 'gnus-util)
+  (unless (gnus-alive-p)
+    (error "You should have Gnus running in this XEmacs session"))
+  ;; this binding is necessary to let message-mode hooks perform correctly
+  (let ((gnus-newsgroup-name (or (patcher-project-option project 'gnus-group)
+				 (read-string "Gnus group name: "))))
+    (gnus-post-news 'post gnus-newsgroup-name)
+    (message-goto-subject)
+    (insert subject)
+    (message-goto-body)))
+
+(eval-when (compile)
+  ;; Shut up the compiler.
+  (defun patch-to-change-log (arg1 &rest arg2))
+  )
+;;;###autoload
+(defun patcher-mail (project subject &optional command arg)
+  "Send a mail about a patch to apply on a project.
+PROJECT is the name of the project (see the variable `patcher-projects').
+SUBJECT is the subject of the message to send.
+
+When called interactively, use a prefix to override the default COMMAND
+for this project; that can be useful, for example, to work with a patch
+in a particular subdirectory or set of files, rather than the whole
+project.
+
+Please note that you can have multiple occurrences of a patcher mail at the
+same time, provided that they concern different projects."
+  (interactive
+   (let* ((prj (assoc (completing-read "Project: " patcher-projects
+				       nil t nil 'patcher-projects-history)
+		      patcher-projects))
+	  (sbj (read-string "Subject: "))
+	  (cmd (patcher-project-command prj)))
+     (list prj sbj cmd current-prefix-arg)))
+  (funcall (intern (concat "patcher-mail-" (symbol-name patcher-mail-method)))
+	   project (concat "[PATCH] " subject))
+  (patcher-minor-mode t)
+  (cd (patcher-project-directory project))
+  ;; do this only after we set up the proper directory !!
+  (and (interactive-p) arg
+       (setq command (read-shell-command "Diff command: " command)))
+  (and (patcher-project-option project 'mail-prologue)
+       (insert "\n" (patcher-project-option project 'mail-prologue)))
+  (save-excursion
+    (insert "\n\n")
+    (setq patcher-patch-marker (point-marker))
+    (message "Generating the diff ...")
+    (insert (format "%s Patch (%s):\n\n"
+		    (patcher-project-name project) command))
+    (sit-for 0) ;; Let XEmacs redisplay the message buffer
+    (shell-command command 'here)
+    (message "Generating the ChangeLog skeletons ...")
+    (sit-for 0) ;; Let XEmacs redisplay the message buffer
+    (narrow-to-region (point) (mark t))
+    (setq patcher-current-project project
+	  patcher-change-logs
+	  (patch-to-change-log (cdr (assoc 'dir project))
+			       :keep-source-files patcher-keep-source-files
+			       :extent-property 'patcher
+			       :extent-property-value (current-buffer)))
+    (widen)
+    (message (substitute-command-keys "Please annotate the ChangeLogs, and run \\[patcher-insert-change-logs] from this buffer when done."))))
+
+;;;###autoload
+(defun patcher-version ()
+  "Show the current version of Patcher."
+  (interactive)
+  (message "Patcher version %s" patcher-version))
+
+(provide 'patcher)
+
+;;; patcher.el ends here