(U-000200B5): Use `->denotational'; use
[chise/xemacs-chise.git.1] / lisp / package-net.el
1 ;;; package-net.el --- Installation and Maintenance of XEmacs packages
2
3 ;; Copyright (C) 2000 Andy Piper.
4
5 ;; Keywords: internal
6
7 ;; This file is part of XEmacs.
8
9 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
22 ;; 02111-1307, USA.
23
24 ;;; Synched up with: Not in FSF
25
26 ;;; Commentary:
27
28 ;; Manipulate packages for the netinstall setup utility
29
30 ;; The process should be so:
31
32 ;; 1. The package maintainer or release manager makes a release
33 ;; announcement.
34 ;;
35 ;; 2. For a new package releases the netinstall maintainer simply
36 ;; needs to update `ftp://ftp.xemacs.org/pub/xemacs/setup.ini'. This is
37 ;; harder than it sounds because the file also includes information
38 ;; about the binary releases. At the moment going to the netinstall
39 ;; directory and typing:
40 ;;
41 ;;   `make XEMACS=<current executable location> setup.ini' 
42 ;;
43 ;; will do the right thing provided that:
44 ;; 
45 ;; (a) `package-net-cygwin32-binary-size' and
46 ;; `package-net-win32-binary-size' are set correctly.
47 ;;
48 ;; (b) The binary pointed to by `XEMACS' has a current
49 ;; `package-index.LATEST.pgp' file. If you don't specify the XEMACS=
50 ;; part then you will get whatever is current for your build tree -
51 ;; which is probably not what you want.
52 ;;
53 ;; You can run `package-net-convert-index-to-ini' manually and specify
54 ;; REMOTE but I generally found that to be inconvenient and error-prone.
55 ;;
56 ;; 3. For package releases that's all you need to do. For binary
57 ;; releases you need to build both cygwin and win32 binaries and put
58 ;; them in appropriate tarballs: This can be achieved by running
59 ;; build-msw-release.sh
60 ;;
61
62 (require 'package-admin)
63 (require 'package-get)
64
65 ;; What path should we use from the myriad available?
66 ;; For netinstall we just want something simple, and anyway this is only to 
67 ;; bootstrap the process. This will be:
68 ;; <root>/setup/ for native windows
69 ;; <root>/lib/xemacs/setup for cygwin.
70 ;;
71 ;;; To Do:
72 ;;
73 ;; 1. Package update functions should also update the installed
74 ;; database so that running setup.exe again does not reinstall
75 ;; packages.
76 ;;
77 ;; 2. Generating setup.ini should be more automatic.
78
79 (defvar package-net-cygwin32-binary-size 0
80   "The size in bytes of the cygwin32 binary distribution.")
81
82 (defvar package-net-win32-binary-size 0
83   "The size in bytes of the win32 binary distribution.")
84
85 (defvar package-net-kit-version ""
86   "XEmacs kitting revision, usually empty.")
87
88 (defvar package-net-setup-version "1.0"
89   "The version string of setup.")
90
91 ;;;###autoload
92 (defun package-net-setup-directory ()
93   (file-truename (concat data-directory "../../" (if (eq system-type 'cygwin32)
94                                                      "xemacs/setup/" "setup/"))))
95
96 (defun package-net-generate-bin-ini (&optional version)
97   "Convert the package index to ini file format in the current directory."
98   (let ((buf (get-buffer-create "*setup-bin.ini*")))
99     (unwind-protect
100         (save-excursion
101           (set-buffer buf)
102           (erase-buffer buf)
103           (goto-char (point-min))
104           (insert "# This file is automatically generated.  If you edit it, your\n")
105           (insert "# edits will be discarded next time the file is generated.\n")
106           (insert "#\n\n")
107           (insert (format "setup-timestamp: %d\n" 
108                           (+ (* (car (current-time)) 65536) (car (cdr (current-time))))))
109           (insert (format "setup-version: %s\n\n" (or version "1.0")))
110           ;; Native version
111           (insert (format "@ %s\n" "xemacs-i586-pc-win32"))
112           (insert (format "version: %s%s\n" emacs-program-version 
113                           package-net-kit-version))
114           (insert "type: native\n")
115           (insert (format "install: win32/%s %d\n\n"
116                           (concat emacs-program-name
117                                   "-i586-pc-win32-"
118                                     emacs-program-version package-net-kit-version 
119                                     ".tar.gz")
120                           package-net-win32-binary-size))
121           ;; Cygwin version
122           (insert (format "@ %s\n" "xemacs-i686-pc-cygwin"))
123           (insert (format "version: %s%s\n" emacs-program-version 
124                           package-net-kit-version))
125           (insert "type: cygwin\n")
126           (insert (format "install: cygwin32/%s %d\n\n"
127                           (concat emacs-program-name
128                                   "-i686-pc-cygwin-"
129                                   emacs-program-version package-net-kit-version
130                                   ".tar.gz") 
131                           package-net-cygwin32-binary-size))
132           (insert "# setup.ini file ends here\n")
133           (write-region (point-min) (point-max) "setup-bin.ini")))
134     (kill-buffer buf)))
135
136 (defun package-net-batch-generate-bin-ini ()
137   "Convert the package index to ini file format."
138   (unless noninteractive
139     (error 'invalid-operation
140            "`package-net-batch-generate-bin-ini' is to be used only with -batch"))
141   (package-net-generate-bin-ini package-net-setup-version))
142
143 ;;;###autoload
144 (defun package-net-update-installed-db (&optional destdir)
145   "Write out the installed package index in a net install suitable format.
146 If DESTDIR is non-nil then use that as the destination directory. 
147 DESTDIR defaults to the value of `package-net-setup-directory'."
148
149   (when (or (eq system-type 'cygwin32)
150             (eq system-type 'window-nt))
151     (setq destdir (file-name-as-directory 
152                    (or destdir (package-net-setup-directory))))
153     (let ((buf (get-buffer-create "*installed.db*")))
154       (unwind-protect
155           (save-excursion
156             (set-buffer buf)
157             (erase-buffer buf)
158             (goto-char (point-min))
159             ;; we use packages-package-list here as we actually want to
160             ;; update relative to the installed reality
161             (let ((entries packages-package-list) entry version)
162               (while entries
163                 (setq entry (car entries))
164                 (setq version (plist-get (cdr entry) :version))
165                 ;; Unfortunately we can't read the size from this
166                 (insert (format "%s %s-%3.2f-pkg.tar.gz 0\n" (symbol-name (car entry))
167                                 (symbol-name (car entry))
168                                 version))
169                 (setq entries (cdr entries))))
170             (make-directory-path destdir)
171             (write-region (point-min) (point-max) (concat destdir "installed.db")))
172         (kill-buffer buf)))))
173
174 (defun package-net-convert-download-sites-to-mirrors (&optional destdir)
175   "Write out the download site list in a net install suitable format.
176 If DESTDIR is non-nil then use that as the destination directory. 
177 DESTDIR defaults to the value of `data-directory'."
178
179   (setq destdir (file-name-as-directory (or destdir data-directory)))
180   (let ((buf (get-buffer-create "*mirrors.lst*")))
181     (unwind-protect
182         (save-excursion
183           (set-buffer buf)
184           (erase-buffer buf)
185           (goto-char (point-min))
186           (let ((entries package-get-download-sites) entry)
187             (while entries
188               (setq entry (car entries))
189               (insert (format "ftp://%s/%s;%s;%s\n"
190                               (nth 1 entry) (substring (nth 2 entry) 0 -9)
191                               (nth 0 entry) (nth 0 entry)))
192               (setq entries (cdr entries))))
193           (write-region (point-min) (point-max) (concat destdir "mirrors.lst")))
194       (kill-buffer buf))))