New sumo.el
As I stated before. I would really like this to be run by someone
else closer to ftp.xemacs.org:
Features
1. Torture test to check for consistency of package-get-base and ftp
site.
2. Can exclude packages by request.
3. Does not include 'unstable' packages.
4. Deals with retrieval errors.
5. Auto generates README/
(require 'package-get)
(defvar sumo-package-exclusion-list
'(vc-cc "Conflicts with normal VC package.")
"PList of packages not included in sumo packages with the reason for it.")
(defvar sumo-temp-dir "/scratch/"
"Make sure this is big")
(defun sumo-make-sumo (todir &optional base no-mule)
(interactive "DTarball dest:")
(let* ((temp (make-temp-name (expand-file-name "sumo" sumo-temp-dir)))
(base (or base
(format-time-string "xemacs-sumo-%Y%m%d")))
(name (concat base ".tar.gz"))
(readme (concat base ".README"))
(site-dir (expand-file-name "lib/xemacs/site-packages/" temp))
(mule (expand-file-name "lib/xemacs/mule-packages/" temp))
(dest (expand-file-name "lib/xemacs/xemacs-packages/" temp))
(excl (copy-sequence sumo-package-exclusion-list))
errored
versions
(sumo-package-list
(delete-if
(lambda (p)
(or
(plist-member excl (car p) )
(when (nth 2 p)
(setq excl (nconc excl
(list (car p) "Package in Development/Unstable."))))))
(mapcar (lambda (entry)
(list (car entry)
(or (eq (car entry) 'mule-base)
(memq 'mule-base
(plist-get (cadr entry)
'requires)))
(eq (plist-get (cadr entry)
'distribution)
'unstable)
(plist-get (cadr entry)
'version)
(plist-get (cadr entry)
'author-version)))
package-get-base))))
(display-message 'progress (concat "Fetching packages for" name))
(make-directory temp t)
(make-directory site-dir t)
(make-directory mule t)
(make-directory dest t)
(setq versions
(mapcar
(lambda (p)
(unless (and no-mule (cadr p))
(condition-case error-data
(progn
(package-get (car p) nil 'always (if (cadr p) mule
dest))
(list (car p) (nth 3 p) (nth 4 p)))
(error
(setq excl (plist-put excl (car p) (concat "Error: "
(error-message-string
error-data))))
(setq errored t)
nil))))
sumo-package-list))
(condition-case ()
(make-directory (expand-file-name "etc/sumo" dest)
'with-parents)
(error nil))
(sumo-make-readme (list (expand-file-name "etc/sumo/README" dest)
(expand-file-name readme todir)) name (plist-to-alist excl)
versions)
(call-process "chmod" nil nil nil "-R" "go+rX" temp)
(setq name (expand-file-name name todir))
(if no-mule
(call-process "tar" nil nil nil "--directory" temp
"--create"
"--gzip" "--file" name "lib/xemacs/site-packages"
"lib/xemacs/xemacs-packages")
(call-process "tar" nil nil nil "--directory" temp
"--create"
"--gzip" "--file" name "lib/xemacs/site-packages"
"lib/xemacs/xemacs-packages" "lib/xemacs/mule-packages"))
(call-process "rm" nil nil nil "-rf" temp)
(if errored
(message "There were errors while installing packages"))))
(defun sumo-make-readme (readmes tarball excl in)
(with-temp-buffer
(insert
"This is the README file describing the XEmacs SUMO package tarball.
You can generally find it under the name xemacs-sumo-<date>.tar.gz.
Where <date> is the ISO style date of creation. The current tarball is
named:
" tarball "
The SUMO package tarball is intended for those who have more bandwidth
and disk space than time to figure out which packages they need. It
includes almost all XEmacs packages in their version at time of
creation. The packages have been put in the directory structure
recommend for XEmacs packages. For convenience of use with XEmacs
binary distributions the SUMO tarball contains these with a
'lib/xemacs' prefix. In particular it contains
lib/xemacs/site-packages
Put packages that are not official XEmacs packages
here. (Empty).
lib/xemacs/mule-packages
All packages related to the operation of a MULE enabled
XEmacs. Non MULE XEmacsen do not use them.
lib/xemacs/xemacs-packages
(Almost) all current official XEmacs packages that are
not MULE related.
lib/xemacs/xemacs-packages/etc/sumo/README
This README.
Current packages NOT included in the SUMO tarball:
")
(mapc (lambda (e)
(insert (format "%s (%s)\n" (car e) (cdr e))))
excl)
(insert "
Packages that are included (package, version (author version)):
")
(mapc (lambda (e)
(if e
(insert (if (nth 2 e)
(format "%s, %s (%s)\n" (car e) (cadr e)
(nth 2 e))
(format "%s, %s\n" (car e) (cadr e))))))
in)
;; Now write the stuff
(mapc 'write-file readmes)))