-;;; gulp.el --- Ask for updates for Lisp packages
+;;; gulp.el --- ask for updates for Lisp packages
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007 Free Software Foundation, Inc.
;; Author: Sam Shteingold <shteingd@math.ucla.edu>
;; Maintainer: FSF
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; update.
;;; Code:
+(defgroup gulp nil
+ "Ask for updates for Lisp packages."
+ :prefix "-"
+ :group 'maint)
+
+(defcustom gulp-discard "^;+ *Maintainer: *FSF *$"
+ "*The regexp matching the packages not requiring the request for updates."
+ :type 'regexp
+ :group 'gulp)
+
+(defcustom gulp-tmp-buffer "*gulp*" "The name of the temporary buffer."
+ :type 'string
+ :group 'gulp)
+
+(defcustom gulp-max-len 2000
+ "*Distance into a Lisp source file to scan for keywords."
+ :type 'integer
+ :group 'gulp)
+
+(defcustom gulp-request-header
+ (concat
+ "This message was created automatically.
+I'm going to start pretesting a new version of GNU Emacs soon, so I'd
+like to ask if you have any updates for the Emacs packages you work on.
+You're listed as the maintainer of the following package(s):\n\n")
+ "*The starting text of a gulp message."
+ :type 'string
+ :group 'gulp)
+
+(defcustom gulp-request-end
+ (concat
+ "\nIf you have any changes since the version in the previous release ("
+ (format "%d.%d" emacs-major-version emacs-minor-version)
+ "),
+please send them to me ASAP.
+
+Please don't send the whole file. Instead, please send a patch made with
+`diff -c' that shows precisely the changes you would like me to install.
+Also please include itemized change log entries for your changes;
+please use lisp/ChangeLog as a guide for the style and for what kinds
+of information to include.
+
+Thanks.")
+ "*The closing text in a gulp message."
+ :type 'string
+ :group 'gulp)
+
+(defun gulp-send-requests (dir &optional time)
+ "Send requests for updates to the authors of Lisp packages in directory DIR.
+For each maintainer, the message consists of `gulp-request-header',
+followed by the list of packages (with modification times if the optional
+prefix argument TIME is non-nil), concluded with `gulp-request-end'.
+
+You can't edit the messages, but you can confirm whether to send each one.
+
+The list of addresses for which you decided not to send mail
+is left in the `*gulp*' buffer at the end."
+ (interactive "DRequest updates for Lisp directory: \nP")
+ (save-excursion
+ (set-buffer (get-buffer-create gulp-tmp-buffer))
+ (let ((m-p-alist (gulp-create-m-p-alist
+ (directory-files dir nil "^[^=].*\\.el$" t)
+ dir))
+ ;; Temporarily inhibit undo in the *gulp* buffer.
+ (buffer-undo-list t)
+ mail-setup-hook msg node)
+ (setq m-p-alist
+ (sort m-p-alist
+ (function (lambda (a b)
+ (string< (car a) (car b))))))
+ (while (setq node (car m-p-alist))
+ (setq msg (gulp-create-message (cdr node) time))
+ (setq mail-setup-hook
+ (lambda ()
+ (mail-subject)
+ (insert "It's time for Emacs updates again")
+ (goto-char (point-max))
+ (insert msg)))
+ (mail nil (car node))
+ (goto-char (point-min))
+ (if (y-or-n-p "Send? ") (mail-send)
+ (kill-this-buffer)
+ (set-buffer gulp-tmp-buffer)
+ (insert (format "%s\n\n" node)))
+ (setq m-p-alist (cdr m-p-alist))))
+ (set-buffer gulp-tmp-buffer)
+ (setq buffer-undo-list nil)))
+
-(defvar gulp-search-path (concat source-directory "lisp/")
- "*The search path for the packages to request updates of.")
-
-(defvar gulp-discard "^;+ *Maintainer: *FSF *$"
- "*The regexp matching the packages not requiring the request for updates.")
-
-(defvar gulp-packages (directory-files gulp-search-path nil "\\.el$" t)
- "The list of files to consider.")
-
-(defvar gulp-tmp-buffer " *gulp*" "The name of the temporary buffer.")
-
-(defvar gulp-max-len 2000
- "*All the interecting info should be among characters 1 through gulp-max-len.")
-
-(defvar gulp-request-header
- "This message was created automatically.
-Apparently, you are the maintainer of the following package(s):\n\n"
- "*The first line of the mesage.")
-
-(defvar gulp-request-end
- "\nIf your copy is newer than mine, please email me the patches ASAP.\n\n"
- "*The punch line.")
-
-(defun gulp-send-requests ()
- "Send requests for updates to the authors of the packages.
-Consider each file in `gulp-packages;.
-The prepared message consists of `gulp-request-header', followed by the
-list of packages with modification times, concluded with `gulp-request-end'.
-You will NOT be given an opportunity to edit the message, only to send or cancel.
-The list of rejected addresses will be put into `gulp-tmp-buffer'."
- (interactive)
- (let (mail-setup-hook msg node (m-p-alist aaaa)) ;; (gulp-create-m-p-alist gulp-packages)))
- (while (setq node (car m-p-alist))
- (setq msg (gulp-create-message (cdr node)))
- (setq mail-setup-hook '(lambda () (goto-char (point-max)) (insert msg)))
- (mail nil (car node))
- (if (y-or-n-p "Send? ") (mail-send)
- (kill-this-buffer)
- (set-buffer gulp-tmp-buffer)
- (insert (format "%s\n\n" node)))
- (setq m-p-alist (cdr m-p-alist)))))
-
-(defun gulp-create-message (rec)
+(defun gulp-create-message (rec time)
"Return the message string for REC, which is a list like (FILE TIME)."
(let (node (str gulp-request-header))
(while (setq node (car rec))
- (setq str (concat str "\t" (car node) "\tLast modified:\t" (cdr node) "\n"))
+ (setq str (concat str "\t" (car node)
+ (if time (concat "\tLast modified:\t" (cdr node)))
+ "\n"))
(setq rec (cdr rec)))
(concat str gulp-request-end)))
-(defun gulp-create-m-p-alist (flist)
- "Create the maintainer/package alist for files in FLIST.
-List of elements (MAINTAINER . (LIST of PACKAGES))"
- (let (mplist filen node fl-tm)
- (get-buffer-create gulp-tmp-buffer)
- (while flist
- (setq fl-tm (gulp-maintainer (setq filen (car flist))))
- (if (setq mnt (car fl-tm));; there is a definite maintainer
- (if (setq node (assoc mnt mplist));; this is not a new maintainer
- (setq mplist (cons (cons (car node)
- (cons (cons filen (cdr fl-tm))
- (cdr node)))
- (delete node mplist)))
- (setq mplist (cons (list mnt (cons filen (cdr fl-tm))) mplist))))
- (message "%s -- %s" filen fl-tm)
- (setq flist (cdr flist)))
- (set-buffer gulp-tmp-buffer)
- (erase-buffer)
- mplist))
-(defun gulp-maintainer (filenm)
- "Return a list (MAINTAINER TIMESTAMP) for the package FILENM."
+(defun gulp-create-m-p-alist (flist dir)
+ "Create the maintainer/package alist for files in FLIST in DIR.
+That is a list of elements, each of the form (MAINTAINER PACKAGES...)."
(save-excursion
- (let* ((fl (concat gulp-search-path filenm)) mnt
+ (let (mplist filen node mnt-tm mnt tm fl-tm)
+ (get-buffer-create gulp-tmp-buffer)
+ (set-buffer gulp-tmp-buffer)
+ (setq buffer-undo-list t)
+ (while flist
+ (setq fl-tm (gulp-maintainer (setq filen (car flist)) dir))
+ (if (setq tm (cdr fl-tm) mnt (car fl-tm));; there is a definite maintainer
+ (if (setq node (assoc mnt mplist));; this is not a new maintainer
+ (setq mplist (cons (cons mnt (cons (cons filen tm) (cdr node)))
+ (delete node mplist)))
+ (setq mplist (cons (list mnt (cons filen (cdr fl-tm))) mplist))))
+ (setq flist (cdr flist)))
+ (erase-buffer)
+ mplist)))
+
+(defun gulp-maintainer (filenm dir)
+ "Return a list (MAINTAINER TIMESTAMP) for the package FILENM in directory DIR."
+ (save-excursion
+ (let* ((fl (expand-file-name filenm dir)) mnt
(timest (format-time-string "%Y-%m-%d %a %T %Z"
(elt (file-attributes fl) 5))))
(set-buffer gulp-tmp-buffer)
(if (= (length mnt) 0) (setq mnt nil))) ;; "^;; Author: $" --> nil
(cons mnt timest))))
+(provide 'gulp)
+
+;;; arch-tag: 42750a11-460a-4efc-829f-342d075530e5
;;; gulp.el ends here