Mercurial > hg > xemacs-beta
comparison lisp/package-net.el @ 448:3078fd1074e8 r21-2-39
Import from CVS: tag r21-2-39
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 11:38:25 +0200 |
| parents | |
| children | 3d3049ae1304 |
comparison
equal
deleted
inserted
replaced
| 447:4fc5f13f3bd3 | 448:3078fd1074e8 |
|---|---|
| 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 (require 'package-admin) | |
| 31 (require 'package-get) | |
| 32 | |
| 33 ;; What path should we use from the myriad available? | |
| 34 ;; For netinstall we just want something simple, and anyway this is only to | |
| 35 ;; bootstrap the process. This will be: | |
| 36 ;; <root>/setup/ for native windows | |
| 37 ;; <root>/lib/xemacs/setup for cygwin. | |
| 38 (defun package-net-setup-directory () | |
| 39 (file-truename (concat data-directory "../../" (if (eq system-type 'cygwin32) | |
| 40 "xemacs/setup/" "setup/")))) | |
| 41 | |
| 42 (defun package-net-convert-index-to-ini (&optional destdir remote version) | |
| 43 "Convert the package index to ini file format in DESTDIR. | |
| 44 DESTDIR defaults to the value of `data-directory'." | |
| 45 (package-get-require-base remote) | |
| 46 | |
| 47 (setq destdir (file-name-as-directory (or destdir data-directory))) | |
| 48 (let ((buf (get-buffer-create "*setup.ini*"))) | |
| 49 (unwind-protect | |
| 50 (save-excursion | |
| 51 (set-buffer buf) | |
| 52 (erase-buffer buf) | |
| 53 (goto-char (point-min)) | |
| 54 (let ((entries package-get-base) entry plist) | |
| 55 (insert "# This file is automatically generated. If you edit it, your\n") | |
| 56 (insert "# edits will be discarded next time the file is generated.\n") | |
| 57 (insert "#\n\n") | |
| 58 (insert (format "setup-timestamp: %d\n" | |
| 59 (+ (* (car (current-time)) 65536) (car (cdr (current-time)))))) | |
| 60 (insert (format "setup-version: %s\n\n" (or version "1.0"))) | |
| 61 ;; Native version | |
| 62 ;; We give the package a capitalised name so that it appears at the top | |
| 63 (insert (format "@ %s\n" "xemacs-i586-pc-win32")) | |
| 64 (insert (format "version: %s\n" emacs-program-version)) | |
| 65 (insert "type: native\n") | |
| 66 (insert (format "install: binaries/win32/%s %d\n\n" | |
| 67 (concat emacs-program-name | |
| 68 "-i586-pc-win32-" | |
| 69 emacs-program-version ".tar.gz") 0)) | |
| 70 ;; Cygwin version | |
| 71 ;; We give the package a capitalised name so that it appears at the top | |
| 72 (insert (format "@ %s\n" "xemacs-i686-pc-cygwin32")) | |
| 73 (insert (format "version: %s\n" emacs-program-version)) | |
| 74 (insert "type: cygwin\n") | |
| 75 (insert (format "install: binaries/cygwin32/%s %d\n\n" | |
| 76 (concat emacs-program-name | |
| 77 "-i686-pc-cygwin32-" | |
| 78 emacs-program-version ".tar.gz") 6779200)) | |
| 79 ;; Standard packages | |
| 80 (while entries | |
| 81 (setq entry (car entries)) | |
| 82 (setq plist (car (cdr entry))) | |
| 83 (insert (format "@ %s\n" (symbol-name (car entry)))) | |
| 84 (insert (format "version: %s\n" (plist-get plist 'version))) | |
| 85 (insert (format "install: packages/%s %s\n" (plist-get plist 'filename) | |
| 86 (plist-get plist 'size))) | |
| 87 ;; These are not supported as yet | |
| 88 ;; | |
| 89 ;; (insert (format "source: %s\n" (plist-get plist 'source))) | |
| 90 ;; (insert "[prev]\n") | |
| 91 ;; (insert (format "version: %s\n" (plist-get plist 'version))) | |
| 92 ;; (insert (format "install: %s\n" (plist-get plist 'filename))) | |
| 93 ;; (insert (format "source: %s\n" (plist-get plist 'source))) | |
| 94 (insert "\n") | |
| 95 (setq entries (cdr entries)))) | |
| 96 (insert "# setup.ini file ends here\n") | |
| 97 (write-region (point-min) (point-max) (concat destdir "setup.ini"))) | |
| 98 (kill-buffer buf)))) | |
| 99 | |
| 100 (defun package-net-update-installed-db (&optional destdir) | |
| 101 "Write out the installed package index in a net install suitable format. | |
| 102 If DESTDIR is non-nil then use that as the destination directory. | |
| 103 DESTDIR defaults to the value of `package-net-setup-directory'." | |
| 104 ;; Need the local version | |
| 105 (package-get-require-base) | |
| 106 | |
| 107 (setq destdir (file-name-as-directory | |
| 108 (or destdir (package-net-setup-directory)))) | |
| 109 (let ((buf (get-buffer-create "*installed.db*"))) | |
| 110 (unwind-protect | |
| 111 (save-excursion | |
| 112 (set-buffer buf) | |
| 113 (erase-buffer buf) | |
| 114 (goto-char (point-min)) | |
| 115 (let ((entries package-get-base) entry plist) | |
| 116 (while entries | |
| 117 (setq entry (car entries)) | |
| 118 (setq plist (car (cdr entry))) | |
| 119 (insert (format "%s %s %s\n" (symbol-name (car entry)) | |
| 120 (plist-get plist 'filename) | |
| 121 (plist-get plist 'size))) | |
| 122 (setq entries (cdr entries)))) | |
| 123 (make-directory-path destdir) | |
| 124 (write-region (point-min) (point-max) (concat destdir "installed.db"))) | |
| 125 (kill-buffer buf)))) | |
| 126 | |
| 127 (defun package-net-convert-download-sites-to-mirrors (&optional destdir) | |
| 128 "Write out the download site list in a net install suitable format. | |
| 129 If DESTDIR is non-nil then use that as the destination directory. | |
| 130 DESTDIR defaults to the value of `data-directory'." | |
| 131 | |
| 132 (setq destdir (file-name-as-directory (or destdir data-directory))) | |
| 133 (let ((buf (get-buffer-create "*mirrors.lst*"))) | |
| 134 (unwind-protect | |
| 135 (save-excursion | |
| 136 (set-buffer buf) | |
| 137 (erase-buffer buf) | |
| 138 (goto-char (point-min)) | |
| 139 (let ((entries package-get-download-sites) entry) | |
| 140 (while entries | |
| 141 (setq entry (car entries)) | |
| 142 (insert (format "ftp://%s/%s;%s;%s\n" | |
| 143 (nth 1 entry) (substring (nth 2 entry) 0 -9) | |
| 144 (nth 0 entry) (nth 0 entry))) | |
| 145 (setq entries (cdr entries)))) | |
| 146 (write-region (point-min) (point-max) (concat destdir "mirrors.lst"))) | |
| 147 (kill-buffer buf)))) |