;; Retrieve a package and any other required packages from an archive
;;
;;
-;; Note (JV): Most of this no longer aplies!
+;; Note (JV): Most of this no longer applies!
;;
;; The idea:
;; A new XEmacs lisp-only release is generated with the following steps:
;; vm - a mail reader
;; [] Always install
;; [] Needs updating
-;; [] Required by other [packages]
+;; [] Required by other [packages]
;;
;; Where `[]' indicates a toggle box
;;
;; - "Required by other" means some other packages are going to force
;; this to be installed. Clicking on [packages] gives a list
;; of packages that require this.
-;;
+;;
;; The `package-get-base' should be installed in a file in
;; `data-directory'. The `package-get-here' should be installed in
;; site-lisp. Both are then read at run time.
"Automatic Package Fetcher and Installer."
:prefix "package-get"
:group 'package-tools)
-
+
+;;;###autoload
(defvar package-get-base nil
"List of packages that are installed at this site.
For each element in the alist, car is the package name and the cdr is
(list :tag "Remote" host-name directory) ))
:group 'package-get)
+;;;###autoload
(defcustom package-get-download-sites
'(
;; North America
+ ("Pre-Releases" "ftp.xemacs.org" "pub/xemacs/beta/experimental/packages")
("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages")
- ("cso.uiuc.edu" "ftp.cso.uiuc.edu" "pub/packages/xemacs/packages")
+ ("crc.ca (Canada)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages")
+ ("ualberta.ca (Canada)" "sunsite.ualberta.ca" "pub/Mirror/xemacs/packages")
+ ("uiuc.edu (United States)" "uiarchive.uiuc.edu" "pub/packages/xemacs/packages")
+ ("unc.edu (United States)" "metalab.unc.edu" "pub/packages/editors/xemacs/packages")
+ ("utk.edu (United States)" "ftp.sunsite.utk.edu" "pub/xemacs/packages")
;; South America
- ("unicamp.br" "ftp.unicamp.br" "pub/xemacs/packages")
+ ("unicamp.br (Brazil)" "ftp.unicamp.br" "pub/xemacs/packages")
;; Europe
- ("sunsite.cnlab-switch.ch" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages")
- ("tu-darmstadt.de" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages")
- ("sunsite.auc.dk" "sunsite.auc.dk" "pub/emacs/xemacs/packages")
- ("pasteur.fr" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
- ("cenatls.cena.dgac.fr" "ftp.cenatls.cena.dgac.fr" "pub/Emacs/xemacs/packages")
- ("kfki.hu" "ftp.kfki.hu" "pub/packages/xemacs/packages")
- ("uniroma2.it" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages")
- ("icm.edu.pl" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages")
- ("sunet.se" "ftp.sunet.se" "pub/gnu/xemacs/packages")
- ("doc.ic.ac.uk" "ftp.doc.ic.ac.uk" "packages/xemacs/packages")
- ("srcc.msu.su" "ftp1.srcc.msu.su" "mirror/ftp.xemacs.org/packages")
+ ("tuwien.ac.at (Austria)" "gd.tuwien.ac.at" "editors/xemacs/packages")
+ ("auc.dk (Denmark)" "sunsite.auc.dk" "pub/emacs/xemacs/packages")
+ ("doc.ic.ac.uk (England)" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages")
+ ("funet.fi (Finland)" "ftp.funet.fi" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages")
+ ("cenatls.cena.dgac.fr (France)" "ftp.cenatls.cena.dgac.fr" "Emacs/xemacs/packages")
+ ("pasteur.fr (France)" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
+ ("tu-darmstadt.de (Germany)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages")
+ ("kfki.hu (Hungary)" "ftp.kfki.hu" "pub/packages/xemacs/packages")
+ ("eunet.ie (Ireland)" "ftp.eunet.ie" "mirrors/ftp.xemacs.org/pub/xemacs/packages")
+ ("uniroma2.it (Italy)" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages")
+ ("uio.no (Norway)" "sunsite.uio.no" "pub/xemacs/packages")
+ ("icm.edu.pl (Poland)" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages")
+ ("srcc.msu.su (Russia)" "ftp.srcc.msu.su" "mirror/ftp.xemacs.org/packages")
+ ("sunet.se (Sweden)" "ftp.sunet.se" "pub/gnu/xemacs/packages")
+ ("cnlab-switch.ch (Switzerland)" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages")
;; Asia
- ("usyd.edu.au" "ftp.usyd.edu.au" "pub/Xemacs/packages")
- ("netlab.is.tsukuba.ac.jp" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages")
- ("jaist.ac.jp" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages")
- ("ring.aist.go.jp" "ring.aist.go.jp" "pub/text/xemacs/packages")
- ("ring.asahi-net.or.jp" "ring.asahi-net.or.jp" "pub/text/xemacs/packages")
- ("SunSITE.sut.ac.jp" "SunSITE.sut.ac.jp" "pub/archives/packages/xemacs/packages")
- ("dti.ad.jp" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages")
- ("kreonet.re.kr" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages")
+ ("aist.go.jp (Japan)" "ring.aist.go.jp" "pub/text/xemacs/packages")
+ ("asahi-net.or.jp (Japan)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages")
+ ("dti.ad.jp (Japan)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages")
+ ("jaist.ac.jp (Japan)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages")
+ ("nucba.ac.jp (Japan)" "mirror.nucba.ac.jp" "mirror/xemacs/packages")
+ ("sut.ac.jp (Japan)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages")
+ ("tsukuba.ac.jp (Japan)" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages")
+ ("kreonet.re.kr (Korea)" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages")
+ ("nctu.edu.tw (Taiwan)" "coda.nctu.edu.tw" "Editors/xemacs/packages")
+
+ ;; Africa
+ ("sun.ac.za (South Africa)" "ftp.sun.ac.za" "xemacs/packages")
+
+ ;; Middle East
+ ("isu.net.sa (Saudi Arabia)" "ftp.isu.net.sa" "pub/mirrors/ftp.xemacs.org/packages")
+
+ ;; Australia
+ ("aarnet.edu.au (Australia)" "mirror.aarnet.edu.au" "pub/xemacs/packages")
)
"*List of remote sites available for downloading packages.
List format is '(site-description site-name directory-on-site).
This variable is used to initialize `package-get-remote', the
variable actually used to specify package download sites."
:tag "Package download sites"
- :type '(repeat (list hostname directory))
+ :type '(repeat (list (string :tag "Name") host-name directory))
:group 'package-get)
(defcustom package-get-remove-copy t
- "*After copying and installing a package, if this is T, then remove the
+ "*After copying and installing a package, if this is t, then remove the
copy. Otherwise, keep it around."
:type 'boolean
:group 'package-get)
:type 'file
:group 'package-get)
+(defvar package-get-user-index-filename
+ (paths-construct-path (list user-init-directory package-get-base-filename))
+ "Name for the user-specific location of the package-get database file.")
+
(defcustom package-get-always-update nil
"*If Non-nil always make sure we are using the latest package index (base).
Otherwise respect the `force-current' argument of `package-get-require-base'."
(defun package-get-download-menu ()
"Build the `Add Download Site' menu."
(mapcar (lambda (site)
- (vector (car site)
- `(package-ui-add-site (quote ,(cdr site)))
- :style 'toggle :selected
- `(member (quote ,(cdr site)) package-get-remote)))
- package-get-download-sites))
+ (vector (car site)
+ `(if (member (quote ,(cdr site))
+ package-get-remote)
+ (setq package-get-remote
+ (delete (quote ,(cdr site))
+ package-get-remote))
+ (package-ui-add-site (quote ,(cdr site))))
+ :style 'toggle
+ :selected `(member (quote ,(cdr site))
+ package-get-remote)))
+ package-get-download-sites))
;;;###autoload
(defun package-get-require-base (&optional force-current)
"Locate the package-get index file. Do not return remote paths if NO-REMOTE
is non-nil."
(or (package-get-locate-file package-get-base-filename t no-remote)
- (locate-data-file package-get-base-filename)
- package-get-base-filename))
-
-(defvar package-get-user-package-location user-init-directory)
+ (if (file-exists-p package-get-user-index-filename)
+ package-get-user-index-filename)))
(defun package-get-maybe-save-index (filename)
"Offer to save the current buffer as the local package index file,
if different."
(let ((location (package-get-locate-index-file t)))
(unless (and filename (equal filename location))
- (unless (equal (md5 (current-buffer))
- (with-temp-buffer
- (insert-file-contents location)
- (md5 (current-buffer))))
- (unless (file-writable-p location)
- (setq location (expand-file-name package-get-base-filename
- (expand-file-name "etc/" package-get-user-package-location))))
- (when (y-or-n-p (concat "Update package index in" location "? "))
- (write-file location))))))
-
+ (unless (and location
+ (equal (md5 (current-buffer))
+ (with-temp-buffer
+ (insert-file-contents-literally location)
+ (md5 (current-buffer)))))
+ (unless (and location (file-writable-p location))
+ (setq location package-get-user-index-filename))
+ (when (y-or-n-p (concat "Update package index in " location "? "))
+ (let ((coding-system-for-write 'binary))
+ (write-file location)))))))
+
;;;###autoload
(defun package-get-update-base (&optional db-file force-current)
(save-excursion
(set-buffer buf)
(erase-buffer buf)
- (insert-file-contents-internal db-file)
+ (insert-file-contents-literally db-file)
(package-get-update-base-from-buffer buf)
(if (file-remote-p db-file)
(package-get-maybe-save-index db-file)))
"package-get DB verification? ")))))
(t nil)))))
(error "Package-get PGP signature failed to verify"))
- ;; ToDo: We shoud call package-get-maybe-save-index on the region
+ ;; ToDo: We should call package-get-maybe-save-index on the region
(package-get-update-base-entries content-beg content-end)
(message "Updated package-get database"))))
-(defun package-get-update-base-entries (beg end)
+(defun package-get-update-base-entries (start end)
"Update the package-get database with the entries found between
-BEG and END in the current buffer."
+START and END in the current buffer."
(save-excursion
- (goto-char beg)
+ (goto-char start)
(if (not (re-search-forward "^(package-get-update-base-entry" nil t))
(error "Buffer does not contain package-get database entries"))
(beginning-of-line)
a symbol instead of a string if PACKAGE-SYMBOL is non-nil.
The return value is suitable for direct passing to `interactive'."
(package-get-require-base t)
- (let ( (table (mapcar '(lambda (item)
- (let ( (name (symbol-name (car item))) )
- (cons name name)
- ))
- package-get-base))
- package package-symbol default-version version)
+ (let ((table (mapcar #'(lambda (item)
+ (let ((name (symbol-name (car item))))
+ (cons name name)))
+ package-get-base))
+ package package-symbol default-version version)
(save-window-excursion
(setq package (completing-read "Package: " table nil t))
(setq package-symbol (intern package))
(if get-version
(progn
- (setq default-version
- (package-get-info-prop
+ (setq default-version
+ (package-get-info-prop
(package-get-info-version
(package-get-info-find-package package-get-base
package-symbol) nil)
)
(if package-symbol
(list package-symbol)
- (list package)))
- )))
+ (list package))))))
;;;###autoload
(defun package-get-delete-package (package &optional pkg-topdir)
(mapcar
#'(lambda (reqd)
(let* ((reqd-package (package-get-package-provider reqd))
- (reqd-version (cadr reqd-package))
(reqd-name (car reqd-package)))
(if (null reqd-name)
(error "Unable to find a provider for %s" reqd))
INSTALL-DIR, if non-nil, specifies the package directory where
fetched packages should be installed.
-The value of `package-get-base' is used to determine what files should
+The value of `package-get-base' is used to determine what files should
be retrieved. The value of `package-get-remote' is used to determine
where a package should be retrieved from. The sites are tried in
order so one is better off listing easily reached sites first.
current-dir-entry current-filename))
;; Get it
(setq full-package-filename dest-filename)
- (message "Retrieving package `%s' ..."
+ (message "Retrieving package `%s' ..."
current-filename)
(sit-for 0)
(copy-file (package-get-remote-filename current-dir-entry
;; Doing it with XEmacs removes the need for an external md5 program
(message "Validating checksum for `%s'..." package) (sit-for 0)
(with-temp-buffer
- ;; What ever happened to i-f-c-literally
- (let (file-name-handler-alist)
- (insert-file-contents-internal full-package-filename))
+ (insert-file-contents-literally full-package-filename)
(if (not (string= (md5 (current-buffer))
(package-get-info-prop this-package
'md5sum)))
To access fields returned from this, use
`package-get-info-version' to return information about particular a
-version. Use `package-get-info-find-prop' to find particular property
+version. Use `package-get-info-find-prop' to find particular property
from a version returned by `package-get-info-version'."
(interactive "xPackage list: \nsPackage Name: ")
(if which
(defun package-get-info-version (package version)
"In PACKAGE, return the plist associated with a particular VERSION of the
package. PACKAGE is typically as returned by
- `package-get-info-find-package'. If VERSION is nil, then return the
+ `package-get-info-find-package'. If VERSION is nil, then return the
first (aka most recent) version. Use `package-get-info-find-prop'
to retrieve a particular property from the value returned by this."
(interactive (package-get-interactive-package-query t t))
not, then it uses the (car search) as the remote site-name and the (cadr
search) as the remote-directory and concatenates filename. In other
words
- site-name:remote-directory/filename
+ site-name:remote-directory/filename.
+
+If (car search) is nil, (cadr search is interpreted as a local directory).
"
- (if (efs-ftp-path filename)
+ (if (file-remote-p filename)
filename
(let ((dir (cadr search)))
- (concat (if (string-match "@" (car search))
- "/"
- "/anonymous@")
- (car search) ":"
+ (concat (when (car search)
+ (concat
+ (if (string-match "@" (car search))
+ "/"
+ "/anonymous@")
+ (car search) ":"))
(if (string-match "/$" dir)
dir
(concat dir "/"))
(defun package-get-installedp (package version)
"Determine if PACKAGE with VERSION has already been installed.
-I'm not sure if I want to do this by searching directories or checking
+I'm not sure if I want to do this by searching directories or checking
some built in variables. For now, use packages-package-list."
;; Use packages-package-list which contains name and version
(equal (plist-get
(defun package-get-package-provider (sym &optional force-current)
"Search for a package that provides SYM and return the name and
version. Searches in `package-get-base' for SYM. If SYM is a
- consp, then it must match a corresponding (provide (SYM VERSION)) from
+ consp, then it must match a corresponding (provide (SYM VERSION)) from
the package.
If FORCE-CURRENT is non-nil make sure the database is up to date. This might
(package-get-info-prop (car this-package) 'version))))
(setq this-package (cdr this-package)))))
(setq packages (cdr packages)))
+ (when (interactive-p)
+ (if found
+ (message "%S" found)
+ (message "No appropriate package found")))
found))
;;
"Fetch and install the latest versions of all customized packages."
(interactive)
(package-get-require-base t)
- ;; Load a fresh copy
- (load "package-get-custom.el")
(mapcar (lambda (pkg)
(if (eval (intern (concat (symbol-name (car pkg)) "-package")))
(package-get (car pkg) nil))
(defun package-get-ever-installed-p (pkg &optional notused)
(string-match "-package$" (symbol-name pkg))
- (custom-initialize-set
- pkg
- (if (package-get-info-find-package
- packages-package-list
+ (custom-initialize-set
+ pkg
+ (if (package-get-info-find-package
+ packages-package-list
(intern (substring (symbol-name pkg) 0 (match-beginning 0))))
t)))
(custom-var (intern (concat (symbol-name package) "-package")))
(description (plist-get props 'description)))
(when (not (memq group package-get-custom-groups))
- (setq package-get-custom-groups (cons package
+ (setq package-get-custom-groups (cons group
package-get-custom-groups))
(eval `(defgroup ,group nil
,(concat category " package group")
projects / chise / xemacs-chise.git.1 / blobdiff