1 ;;; gulp.el --- Ask for updates for Lisp packages
3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
5 ;; Author: Sam Shteingold <shteingd@math.ucla.edu>
7 ;; Keywords: maintenance
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27 ;; Search the emacs/{version}/lisp directory for *.el files, extract the
28 ;; name of the author or maintainer and send him e-mail requesting
33 (defvar gulp-search-path
(concat source-directory
"lisp/")
34 "*The search path for the packages to request updates of.")
36 (defvar gulp-discard
"^;+ *Maintainer: *FSF *$"
37 "*The regexp matching the packages not requiring the request for updates.")
39 (defvar gulp-packages
(directory-files gulp-search-path nil
"\\.el$" t
)
40 "The list of files to consider.")
42 (defvar gulp-tmp-buffer
" *gulp*" "The name of the temporary buffer.")
44 (defvar gulp-max-len
2000
45 "*All the interecting info should be among characters 1 through gulp-max-len.")
47 (defvar gulp-request-header
48 "This message was created automatically.
49 Apparently, you are the maintainer of the following package(s):\n\n"
50 "*The first line of the mesage.")
52 (defvar gulp-request-end
53 "\nIf your copy is newer than mine, please email me the patches ASAP.\n\n"
56 (defun gulp-send-requests ()
57 "Send requests for updates to the authors of the packages.
58 Consider each file in `gulp-packages;.
59 The prepared message consists of `gulp-request-header', followed by the
60 list of packages with modification times, concluded with `gulp-request-end'.
61 You will NOT be given an opportunity to edit the message, only to send or cancel.
62 The list of rejected addresses will be put into `gulp-tmp-buffer'."
64 (let (mail-setup-hook msg node
(m-p-alist aaaa
)) ;; (gulp-create-m-p-alist gulp-packages)))
65 (while (setq node
(car m-p-alist
))
66 (setq msg
(gulp-create-message (cdr node
)))
67 (setq mail-setup-hook
'(lambda () (goto-char (point-max)) (insert msg
)))
69 (if (y-or-n-p "Send? ") (mail-send)
71 (set-buffer gulp-tmp-buffer
)
72 (insert (format "%s\n\n" node
)))
73 (setq m-p-alist
(cdr m-p-alist
)))))
75 (defun gulp-create-message (rec)
76 "Return the message string for REC, which is a list like (FILE TIME)."
77 (let (node (str gulp-request-header
))
78 (while (setq node
(car rec
))
79 (setq str
(concat str
"\t" (car node
) "\tLast modified:\t" (cdr node
) "\n"))
81 (concat str gulp-request-end
)))
83 (defun gulp-create-m-p-alist (flist)
84 "Create the maintainer/package alist for files in FLIST.
85 List of elements (MAINTAINER . (LIST of PACKAGES))"
86 (let (mplist filen node fl-tm
)
87 (get-buffer-create gulp-tmp-buffer
)
89 (setq fl-tm
(gulp-maintainer (setq filen
(car flist
))))
90 (if (setq mnt
(car fl-tm
));; there is a definite maintainer
91 (if (setq node
(assoc mnt mplist
));; this is not a new maintainer
92 (setq mplist
(cons (cons (car node
)
93 (cons (cons filen
(cdr fl-tm
))
95 (delete node mplist
)))
96 (setq mplist
(cons (list mnt
(cons filen
(cdr fl-tm
))) mplist
))))
97 (message "%s -- %s" filen fl-tm
)
98 (setq flist
(cdr flist
)))
99 (set-buffer gulp-tmp-buffer
)
103 (defun gulp-maintainer (filenm)
104 "Return a list (MAINTAINER TIMESTAMP) for the package FILENM."
106 (let* ((fl (concat gulp-search-path filenm
)) mnt
107 (timest (format-time-string "%Y-%m-%d %a %T %Z"
108 (elt (file-attributes fl
) 5))))
109 (set-buffer gulp-tmp-buffer
)
111 (insert-file-contents fl nil
0 gulp-max-len
)
113 (if (re-search-forward gulp-discard nil t
)
114 (setq mnt nil
) ;; do nothing, return nil
116 (if (and (re-search-forward "^;+ *Maintainer: \\(.*\\)$" nil t
)
117 (> (length (setq mnt
(match-string 1))) 0))
120 (if (re-search-forward "^;+ *Author: \\(.*\\)$" nil t
)
121 (setq mnt
(match-string 1))))
122 (if (= (length mnt
) 0) (setq mnt nil
))) ;; "^;; Author: $" --> nil
125 ;;; gulp.el ends here