Commit 3ecaf18e authored by Richard M. Stallman's avatar Richard M. Stallman

Initial revision

parent 67f445d7
;;; 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment