From: Richard M. Stallman <rms@gnu.org>
Date: Tue, 7 May 1996 00:55:56 +0000 (+0000)
Subject: Initial revision
X-Git-Tag: emacs-19.34~684
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3ecaf18e6bc523bae637bebd6e2f35d68304e742;p=emacs.git

Initial revision
---

diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el
new file mode 100644
index 00000000000..92ac453a03a
--- /dev/null
+++ b/lisp/emacs-lisp/gulp.el
@@ -0,0 +1,125 @@
+;;; gulp.el --- Ask for updates for Lisp packages
+
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Sam Shteingold <shteingd@math.ucla.edu>
+;; Maintainer: FSF
+;; Keywords: maintenance
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; Search the emacs/{version}/lisp directory for *.el files, extract the
+;; name of the author or maintainer and send him e-mail requesting
+;; update.
+
+;;; Code:
+
+(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)
+  "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 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."
+  (save-excursion
+    (let* ((fl (concat gulp-search-path filenm)) mnt
+	   (timest (format-time-string "%Y-%m-%d %a %T %Z"
+				       (elt (file-attributes fl) 5))))
+      (set-buffer gulp-tmp-buffer)
+      (erase-buffer)
+      (insert-file-contents fl nil 0 gulp-max-len)
+      (goto-char 1)
+      (if (re-search-forward gulp-discard nil t)
+	  (setq mnt nil) ;; do nothing, return nil
+	(goto-char 1)
+	(if (and (re-search-forward "^;+ *Maintainer: \\(.*\\)$" nil t)
+		 (> (length (setq mnt (match-string 1))) 0))
+	    () ;; found!
+	  (goto-char 1)
+	  (if (re-search-forward "^;+ *Author: \\(.*\\)$" nil t)
+	      (setq mnt (match-string 1))))
+	(if (= (length mnt) 0) (setq mnt nil))) ;; "^;; Author: $" --> nil
+      (cons mnt timest))))
+
+;;; gulp.el ends here