git.chise.org Git - chise/xemacs-chise.git.1/blob - 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 (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))))