view lisp/package-net.el @ 5318:203dcac81dae

Provide some milquetoast compatibility in our errors, type-error, program-error 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl.el: Provde the Common Lisp program-error, type-error as error symbols. This doesn't nearly go far enough for anyone using the Common Lisp errors.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 30 Dec 2010 00:15:37 +0000
parents 44de306310b8
children 308d34e9f07d
line wrap: on
line source

;;; package-net.el --- Installation and Maintenance of XEmacs packages

;; Copyright (C) 2000 Andy Piper.

;; Keywords: internal

;; This file is part of XEmacs.

;; XEmacs 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.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; Manipulate packages for the netinstall setup utility

;; The process should be so:

;; 1. The package maintainer or release manager makes a release
;; announcement.
;;
;; 2. For a new package releases the netinstall maintainer simply
;; needs to update `ftp://ftp.xemacs.org/pub/xemacs/setup.ini'. This is
;; harder than it sounds because the file also includes information
;; about the binary releases. At the moment going to the netinstall
;; directory and typing:
;;
;;   `make XEMACS=<current executable location> setup.ini' 
;;
;; will do the right thing provided that:
;; 
;; (a) `package-net-cygwin32-binary-size' and
;; `package-net-win32-binary-size' are set correctly.
;;
;; (b) The binary pointed to by `XEMACS' has a current
;; `package-index.LATEST.pgp' file. If you don't specify the XEMACS=
;; part then you will get whatever is current for your build tree -
;; which is probably not what you want.
;;
;; You can run `package-net-convert-index-to-ini' manually and specify
;; REMOTE but I generally found that to be inconvenient and error-prone.
;;
;; 3. For package releases that's all you need to do. For binary
;; releases you need to build both cygwin and win32 binaries and put
;; them in appropriate tarballs: This can be achieved by running
;; build-msw-release.sh
;;

(require 'package-admin)
(require 'package-get)

;; What path should we use from the myriad available?
;; For netinstall we just want something simple, and anyway this is only to 
;; bootstrap the process. This will be:
;; <root>/setup/ for native windows
;; <root>/lib/xemacs/setup for cygwin.
;;
;;; To Do:
;;
;; 1. Package update functions should also update the installed
;; database so that running setup.exe again does not reinstall
;; packages.
;;
;; 2. Generating setup.ini should be more automatic.

(defvar package-net-cygwin32-binary-size 0
  "The size in bytes of the cygwin32 binary distribution.")

(defvar package-net-win32-binary-size 0
  "The size in bytes of the win32 binary distribution.")

(defvar package-net-kit-version ""
  "XEmacs kitting revision, usually empty.")

(defvar package-net-setup-version "1.0"
  "The version string of setup.")

;;;###autoload
(defun package-net-setup-directory ()
  (file-truename (concat data-directory "../../" (if (eq system-type 'cygwin32)
						     "xemacs/setup/" "setup/"))))

(defun package-net-generate-bin-ini (&optional version)
  "Convert the package index to ini file format in the current directory."
  (let ((buf (get-buffer-create "*setup-bin.ini*")))
    (unwind-protect
        (save-excursion
          (set-buffer buf)
          (erase-buffer buf)
          (goto-char (point-min))
	  (insert "# This file is automatically generated.  If you edit it, your\n")
	  (insert "# edits will be discarded next time the file is generated.\n")
	  (insert "#\n\n")
	  (insert (format "setup-timestamp: %d\n" 
			  (+ (* (car (current-time)) 65536) (car (cdr (current-time))))))
	  (insert (format "setup-version: %s\n\n" (or version "1.0")))
	  ;; Native version
	  (insert (format "@ %s\n" "xemacs-i586-pc-win32"))
	  (insert (format "version: %s%s\n" emacs-program-version 
			  package-net-kit-version))
	  (insert "type: native\n")
	  (insert (format "install: win32/%s %d\n\n"
			  (concat emacs-program-name
				  "-i586-pc-win32-"
				    emacs-program-version package-net-kit-version 
				    ".tar.gz")
			  package-net-win32-binary-size))
	  ;; Cygwin version
	  (insert (format "@ %s\n" "xemacs-i686-pc-cygwin"))
	  (insert (format "version: %s%s\n" emacs-program-version 
			  package-net-kit-version))
	  (insert "type: cygwin\n")
	  (insert (format "install: cygwin32/%s %d\n\n"
			  (concat emacs-program-name
				  "-i686-pc-cygwin-"
				  emacs-program-version package-net-kit-version
				  ".tar.gz") 
			  package-net-cygwin32-binary-size))
	  (insert "# setup.ini file ends here\n")
	  (write-region (point-min) (point-max) "setup-bin.ini")))
    (kill-buffer buf)))

(defun package-net-batch-generate-bin-ini ()
  "Convert the package index to ini file format."
  (unless noninteractive
    (error 'invalid-operation
	   "`package-net-batch-generate-bin-ini' is to be used only with -batch"))
  (package-net-generate-bin-ini package-net-setup-version))

;;;###autoload
(defun package-net-update-installed-db (&optional destdir)
  "Write out the installed package index in a net install suitable format.
If DESTDIR is non-nil then use that as the destination directory. 
DESTDIR defaults to the value of `package-net-setup-directory'."

  (when (or (eq system-type 'cygwin32)
	    (eq system-type 'window-nt))
    (setq destdir (file-name-as-directory 
		   (or destdir (package-net-setup-directory))))
    (let ((buf (get-buffer-create "*installed.db*")))
      (unwind-protect
	  (save-excursion
	    (set-buffer buf)
	    (erase-buffer buf)
	    (goto-char (point-min))
	    ;; we use packages-package-list here as we actually want to
	    ;; update relative to the installed reality
	    (let ((entries packages-package-list) entry version)
	      (while entries
		(setq entry (car entries))
		(setq version (plist-get (cdr entry) :version))
		;; Unfortunately we can't read the size from this
		(insert (format "%s %s-%3.2f-pkg.tar.gz 0\n" (symbol-name (car entry))
				(symbol-name (car entry))
				version))
		(setq entries (cdr entries))))
	    (make-directory-path destdir)
	    (write-region (point-min) (point-max) (concat destdir "installed.db")))
	(kill-buffer buf)))))

(defun package-net-convert-download-sites-to-mirrors (&optional destdir)
  "Write out the download site list in a net install suitable format.
If DESTDIR is non-nil then use that as the destination directory. 
DESTDIR defaults to the value of `data-directory'."

  (setq destdir (file-name-as-directory (or destdir data-directory)))
  (let ((buf (get-buffer-create "*mirrors.lst*")))
    (unwind-protect
        (save-excursion
          (set-buffer buf)
          (erase-buffer buf)
          (goto-char (point-min))
          (let ((entries package-get-download-sites) entry)
	    (while entries
	      (setq entry (car entries))
	      (insert (format "ftp://%s/%s;%s;%s\n"
			      (nth 1 entry) (substring (nth 2 entry) 0 -9)
			      (nth 0 entry) (nth 0 entry)))
	      (setq entries (cdr entries))))
	  (write-region (point-min) (point-max) (concat destdir "mirrors.lst")))
      (kill-buffer buf))))