9:01 a.m.
Hacked this up while not proctoring the national university entrance
exam (still had to sit around with no net access in case one of the
proctors got sick).
Lightly tested. An early version generated the patch "New FAQ.
XEmacs bitches about xmodmap."
;;; sjt/prepare-xemacs-patch
;;
;; Copyright 2001 Stephen J. Turnbull <stephen(a)xemacs.org>
;;
;; This program is free software, and may be redistributed under the
;; terms of the GNU Library General Public License, version 2, or its
;; successor (known as the GNU Lesser General Public License, any version).
;;
;; Function:
;;
;; * Sets up a mail buffer with ChangeLogs and cvs diffs, addressed to
;; xemacs-patches, and an appropriate partial subject.
;;
;; Features:
;;
;; * Automatically scrounges around for ChangeLogs. Will bitch if it
;; doesn't find one with a new entry. (Not reliable: it doesn't have
;; to be the appropriate entry, just a non-null diff.)
;; * ChangeLogs come first, and are not repeated if explicitly requested.
;; * ChangeLogs are diff'ed -U 0, other files are diff'ed -u.
;; * Munges cvs diffs that don't include paths in the "---" and
"+++"
;; lines. (Idea due to Martin's cvs-diff script.)
;; * Bitches if a diff isn't done.
;; * Isn't a Perl script.
;;
;; Misfeatures:
;;
;; * Currently only knows about VM, but should be easily adaptable to
;; message. (Patches welcome!)
;; * Isn't a Perl script.
;;
;; To do:
;;
;; * Offer to retry missing diffs.
;; * Better argument processing.
;; * Check ChangeLog entries against diff'ed files.
;; * Customize.
;; * Port to Perl.
(require 'vm)
(defvar sjt/prepare-xemacs-patch-root
"/coda/Projects/XEmacs"
"Root of XEmacs workspace. XEmacs modules should be checked out into
subdirectories of this directory.")
(defvar sjt/prepare-xemacs-patch-module-tag-alist
'(("21.2-HEAD" . "21.2")
("21.1-HEAD" . "21.1")
("xemacsweb" . "xemacsweb")
("xemacs-packages" . "packages"))
"Map modules (directories) to tags for Subject header.
Each element is a cons of two strings. The cdr can also be nil; if
so, the Subject header will be left empty.")
(defvar sjt/diff-index-re
"^Index:\\s-+\\(\\(\\(?:\\S-+/\\)*\\)\\(\\S-+\\)\\)\\s-*$"
"Regexp matching the Index hint given by cvs diff.
Group 1 matches the whole (relative) path and should be equal to the
requested path. Group 2 matches the directory prefix, and will be inserted
to correct cvs diffs that only give the file name in the change headers.
Group 3 matches the file name.")
(defun sjt/prepare-xemacs-patch (module files)
"Prepare a patch against CVS to a MODULE of XEmacs, applying to FILES.
Uses -U 0 to diff ChangeLogs, and -u to diff files. Inserts the result in
the message buffer and munges the \"---\" and \"+++\" headers to match
the
\"Index\". Leaves point in Subject header after inserting a tag such as
\"[21.2]\" (see `sjt/prepare-xemacs-patch-module-tag-alist').
MODULE is the name of the directory containing the XEmacs module.
FILES is a string containing a space separated list of file specs to be
`cvs diff'ed.
Each spec must be a full path relative to `sjt/prepare-xemacs-patch-root'
concatenated with MODULE (\"top level\"). ChangeLogs will be searched for
in the same directory, the parent, and so on up to top level. They may be
omitted from FILES.
Example: (sjt/prepare-xemacs-patch "21.2-HEAD"
"man/xemacs-faq.texi")
does
cd /coda/Projects/XEmacs/21.2-HEAD
diff -U 0 man/ChangeLog
diff -u man/xemacs-faq.texi
and sets up the header
To: XEmacs Patches <xemacs-patches(a)xemacs.org>
Subject: [21.2]
BUG: The only message agent available is vm-mail."
;; #### Do argument parsing with existence check on $top/$module, and
;; using an iterator to get filenames with check and completion.
(interactive "sModule name: \nsSpace-separated list of files: ")
;; Parse the arguments.
(let ((top (expand-file-name module sjt/prepare-xemacs-patch-root))
(relpaths (split-string files))
(logs nil)
(notfound nil))
;; Air-check module
(if (not (file-exists-p top))
(error "XEmacs module %s doesn't seem to exist!" top)
(setq top (file-name-as-directory top)))
;; Search for and handle ChangeLogs
(let ((paths relpaths))
(while paths
(message "Paths: %s" paths)
(let ((log (car paths)))
(if (and (string-match "ChangeLog" log)
(not (member log logs))
(or (file-exists-p (expand-file-name log top))
;; always non-nil
(setq notfound (cons log notfound))))
(setq logs (cons log logs))
(let ((dir log))
(setq log
(catch 'found
;; try ChangeLog in parent of dir
(while dir
(message "Looking for log as sibling of %s" dir)
(setq dir (file-name-directory
(directory-file-name dir)))
(let ((file (concat dir "ChangeLog")))
(message "Looking for log as %s" file)
(cond ((member file logs)
(throw 'found nil))
((file-exists-p (expand-file-name file top))
(throw 'found file)))))
;; made it to top level without finding a ChangeLog
(setq notfound (cons "ChangeLog" notfound))))
(if log (setq logs (cons log logs)))))
(setq paths (cdr paths)))))
;; Remove ChangeLogs from explicit file list.
(mapcar #'(lambda (log) (setq relpaths (delete log relpaths)))
logs)
;; Aircheck file list (ChangeLogs have all already been checked)
(mapcar #'(lambda (file)
(message "Checking %s" (expand-file-name file top))
(if (not (file-exists-p (expand-file-name file top)))
(setq notfound (cons file notfound))))
relpaths)
(if (and notfound
(y-or-n-p
(format "diffs requested for %s but files(s) not found. Abort? "
notfound)))
(message "Aborted!")
;; Set up message buffer.
(vm-mail "XEmacs Patches <xemacs-patches(a)xemacs.org>")
(insert "\n\n\n")
(backward-char)
(shell-command
(apply #'concat
`("cd "
,(directory-file-name top)
" ; cvs diff -U 0"
,＠(mapcar #'(lambda (el) (concat " " el)) logs)
" 2>/dev/null ; cvs diff -u"
,＠(mapcar #'(lambda (el) (concat " " el)) relpaths)
" 2>/dev/null"))
t)
;; Check for successful cvs diff and munge change lines like mrb's
;; cvs-diff
(let ((diffs (append logs relpaths)))
(mail-text)
(while diffs
(re-search-forward sjt/diff-index-re nil t)
(let ((full (match-string 1))
(prefix (match-string 2))
(file (match-string 3)))
(forward-line 5)
(if (looking-at "^---\\s-+")
(progn
(goto-char (match-end 0))
(cond ((looking-at full))
((looking-at file) (insert prefix))
(t (save-excursion
(mail-text)
(insert
(format "***** bad format in diff of %s *****\n"
full)))))))
(forward-line 1)
(if (looking-at "^\\+\\+\\+\\s-+")
(progn
(goto-char (match-end 0))
(cond ((looking-at full))
((looking-at file) (insert prefix))
(t (save-excursion
(mail-text)
(insert
(format "***** bad format in diff of %s *****\n"
full)))))))
(setq diffs (delete full diffs))))
;; could try redoing the diff here
(when diffs
(mail-text)
(insert (format "**** cvs diff of %s failed! *****" diffs))))
;; Set up subject header
(mail-subject)
(let ((tag (cdr (assoc module
sjt/prepare-xemacs-patch-module-tag-alist))))
(if tag (insert "[" tag "] "))))))
--
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Institute of Policy and Planning Sciences Tel/fax: +81 (298) 53-5091
_________________ _________________ _________________ _________________
What are those straight lines for? "XEmacs rules."