Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 6719134a07c2
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
30 30
31 ;; package-get - 31 ;; package-get -
32 ;; Retrieve a package and any other required packages from an archive 32 ;; Retrieve a package and any other required packages from an archive
33 ;; 33 ;;
34 ;; 34 ;;
35 ;; Note (JV): Most of this no longer aplies! 35 ;; Note (JV): Most of this no longer applies!
36 ;; 36 ;;
37 ;; The idea: 37 ;; The idea:
38 ;; A new XEmacs lisp-only release is generated with the following steps: 38 ;; A new XEmacs lisp-only release is generated with the following steps:
39 ;; 1. The maintainer runs some yet to be written program that 39 ;; 1. The maintainer runs some yet to be written program that
40 ;; generates all the dependency information. This should 40 ;; generates all the dependency information. This should
178 :tag "Package repository" 178 :tag "Package repository"
179 :type '(repeat (choice (list :tag "Local" (const :tag "Local" nil) directory ) 179 :type '(repeat (choice (list :tag "Local" (const :tag "Local" nil) directory )
180 (list :tag "Remote" host-name directory) )) 180 (list :tag "Remote" host-name directory) ))
181 :group 'package-get) 181 :group 'package-get)
182 182
183 ;;;###autoload
183 (defcustom package-get-download-sites 184 (defcustom package-get-download-sites
184 '( 185 '(
185 ;; North America 186 ;; North America
186 ("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages") 187 ("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages")
187 ("cso.uiuc.edu" "ftp.cso.uiuc.edu" "pub/packages/xemacs/packages") 188 ("crc.ca (Canada)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages")
189 ("ualberta.ca (Canada)" "sunsite.ualberta.ca" "pub/Mirror/xemacs/packages")
190 ("uiuc.edu (United States)" "uiarchive.uiuc.edu" "pub/packages/xemacs/packages")
191 ("unc.edu (United States)" "metalab.unc.edu" "pub/packages/editors/xemacs/packages")
192 ("utk.edu (United States)" "ftp.sunsite.utk.edu" "pub/xemacs/packages")
188 193
189 ;; South America 194 ;; South America
190 ("unicamp.br" "ftp.unicamp.br" "pub/xemacs/packages") 195 ("unicamp.br (Brazil)" "ftp.unicamp.br" "pub/xemacs/packages")
191 196
192 ;; Europe 197 ;; Europe
193 ("sunsite.cnlab-switch.ch" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages") 198 ("tuwien.ac.at (Austria)" "gd.tuwien.ac.at" "editors/xemacs/packages")
194 ("tu-darmstadt.de" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages") 199 ("auc.dk (Denmark)" "sunsite.auc.dk" "pub/emacs/xemacs/packages")
195 ("sunsite.auc.dk" "sunsite.auc.dk" "pub/emacs/xemacs/packages") 200 ("doc.ic.ac.uk (England)" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages")
196 ("pasteur.fr" "ftp.pasteur.fr" "pub/computing/xemacs/packages") 201 ("funet.fi (Finland)" "ftp.funet.fi" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages")
197 ("cenatls.cena.dgac.fr" "ftp.cenatls.cena.dgac.fr" "pub/Emacs/xemacs/packages") 202 ("cenatls.cena.dgac.fr (France)" "ftp.cenatls.cena.dgac.fr" "Emacs/xemacs/packages")
198 ("kfki.hu" "ftp.kfki.hu" "pub/packages/xemacs/packages") 203 ("pasteur.fr (France)" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
199 ("uniroma2.it" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages") 204 ("tu-darmstadt.de (Germany)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages")
200 ("icm.edu.pl" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages") 205 ("kfki.hu (Hungary)" "ftp.kfki.hu" "pub/packages/xemacs/packages")
201 ("sunet.se" "ftp.sunet.se" "pub/gnu/xemacs/packages") 206 ("eunet.ie (Ireland)" "ftp.eunet.ie" "mirrors/ftp.xemacs.org/pub/xemacs/packages")
202 ("doc.ic.ac.uk" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages") 207 ("uniroma2.it (Italy)" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages")
203 ("srcc.msu.su" "ftp1.srcc.msu.su" "mirror/ftp.xemacs.org/packages") 208 ("uio.no (Norway)" "sunsite.uio.no" "pub/xemacs/packages")
209 ("icm.edu.pl (Poland)" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages")
210 ("srcc.msu.su (Russia)" "ftp.srcc.msu.su" "mirror/ftp.xemacs.org/packages")
211 ("sunet.se (Sweden)" "ftp.sunet.se" "pub/gnu/xemacs/packages")
212 ("cnlab-switch.ch (Switzerland)" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages")
204 213
205 ;; Asia 214 ;; Asia
206 ("usyd.edu.au" "ftp.usyd.edu.au" "pub/Xemacs/packages") 215 ("aist.go.jp (Japan)" "ring.aist.go.jp" "pub/text/xemacs/packages")
207 ("netlab.is.tsukuba.ac.jp" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages") 216 ("asahi-net.or.jp (Japan)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages")
208 ("jaist.ac.jp" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages") 217 ("dti.ad.jp (Japan)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages")
209 ("ring.aist.go.jp" "ring.aist.go.jp" "pub/text/xemacs/packages") 218 ("jaist.ac.jp (Japan)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages")
210 ("ring.asahi-net.or.jp" "ring.asahi-net.or.jp" "pub/text/xemacs/packages") 219 ("nucba.ac.jp (Japan)" "mirror.nucba.ac.jp" "mirror/xemacs/packages")
211 ("SunSITE.sut.ac.jp" "SunSITE.sut.ac.jp" "pub/archives/packages/xemacs/packages") 220 ("sut.ac.jp (Japan)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages")
212 ("dti.ad.jp" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages") 221 ("tsukuba.ac.jp (Japan)" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages")
213 ("kreonet.re.kr" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages") 222 ("kreonet.re.kr (Korea)" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages")
223 ("nctu.edu.tw (Taiwan)" "coda.nctu.edu.tw" "Editors/xemacs/packages")
224
225 ;; Africa
226 ("sun.ac.za (South Africa)" "ftp.sun.ac.za" "xemacs/packages")
227
228 ;; Middle East
229 ("isu.net.sa (Saudi Arabia)" "ftp.isu.net.sa" "pub/mirrors/ftp.xemacs.org/packages")
230
231 ;; Australia
232 ("aarnet.edu.au (Australia)" "mirror.aarnet.edu.au" "pub/xemacs/packages")
214 ) 233 )
215 "*List of remote sites available for downloading packages. 234 "*List of remote sites available for downloading packages.
216 List format is '(site-description site-name directory-on-site). 235 List format is '(site-description site-name directory-on-site).
217 SITE-DESCRIPTION is a textual description of the site. SITE-NAME 236 SITE-DESCRIPTION is a textual description of the site. SITE-NAME
218 is the internet address of the download site. DIRECTORY-ON-SITE 237 is the internet address of the download site. DIRECTORY-ON-SITE
222 :tag "Package download sites" 241 :tag "Package download sites"
223 :type '(repeat (list hostname directory)) 242 :type '(repeat (list hostname directory))
224 :group 'package-get) 243 :group 'package-get)
225 244
226 (defcustom package-get-remove-copy t 245 (defcustom package-get-remove-copy t
227 "*After copying and installing a package, if this is T, then remove the 246 "*After copying and installing a package, if this is t, then remove the
228 copy. Otherwise, keep it around." 247 copy. Otherwise, keep it around."
229 :type 'boolean 248 :type 'boolean
230 :group 'package-get) 249 :group 'package-get)
231 250
232 ;; #### it may make sense for this to be a list of names. 251 ;; #### it may make sense for this to be a list of names.
237 This may either be a relative path, in which case it is interpreted 256 This may either be a relative path, in which case it is interpreted
238 with respect to `package-get-remote', or an absolute path." 257 with respect to `package-get-remote', or an absolute path."
239 :type 'file 258 :type 'file
240 :group 'package-get) 259 :group 'package-get)
241 260
261 (defvar package-get-user-index-filename
262 (paths-construct-path (list user-init-directory package-get-base-filename))
263 "Name for the user-specific location of the package-get database file.")
264
242 (defcustom package-get-always-update nil 265 (defcustom package-get-always-update nil
243 "*If Non-nil always make sure we are using the latest package index (base). 266 "*If Non-nil always make sure we are using the latest package index (base).
244 Otherwise respect the `force-current' argument of `package-get-require-base'." 267 Otherwise respect the `force-current' argument of `package-get-require-base'."
245 :type 'boolean 268 :type 'boolean
246 :group 'package-get) 269 :group 'package-get)
259 ;Shouldn't this be in package-ui? 282 ;Shouldn't this be in package-ui?
260 ;;;###autoload 283 ;;;###autoload
261 (defun package-get-download-menu () 284 (defun package-get-download-menu ()
262 "Build the `Add Download Site' menu." 285 "Build the `Add Download Site' menu."
263 (mapcar (lambda (site) 286 (mapcar (lambda (site)
264 (vector (car site) 287 (vector (car site)
265 `(package-ui-add-site (quote ,(cdr site))) 288 `(if (member (quote ,(cdr site))
266 :style 'toggle :selected 289 package-get-remote)
267 `(member (quote ,(cdr site)) package-get-remote))) 290 (setq package-get-remote
268 package-get-download-sites)) 291 (delete (quote ,(cdr site)) package-get-remote))
292 (package-ui-add-site (quote ,(cdr site))))
293 :style 'toggle
294 :selected `(member (quote ,(cdr site))
295 package-get-remote)))
296 package-get-download-sites))
269 297
270 ;;;###autoload 298 ;;;###autoload
271 (defun package-get-require-base (&optional force-current) 299 (defun package-get-require-base (&optional force-current)
272 "Require that a package-get database has been loaded. 300 "Require that a package-get database has been loaded.
273 If the optional FORCE-CURRENT argument or the value of 301 If the optional FORCE-CURRENT argument or the value of
326 354
327 (defun package-get-locate-index-file (no-remote) 355 (defun package-get-locate-index-file (no-remote)
328 "Locate the package-get index file. Do not return remote paths if NO-REMOTE 356 "Locate the package-get index file. Do not return remote paths if NO-REMOTE
329 is non-nil." 357 is non-nil."
330 (or (package-get-locate-file package-get-base-filename t no-remote) 358 (or (package-get-locate-file package-get-base-filename t no-remote)
331 (locate-data-file package-get-base-filename) 359 (if (file-exists-p package-get-user-index-filename)
332 package-get-base-filename)) 360 package-get-user-index-filename)))
333
334 (defvar package-get-user-package-location user-init-directory)
335 361
336 (defun package-get-maybe-save-index (filename) 362 (defun package-get-maybe-save-index (filename)
337 "Offer to save the current buffer as the local package index file, 363 "Offer to save the current buffer as the local package index file,
338 if different." 364 if different."
339 (let ((location (package-get-locate-index-file t))) 365 (let ((location (package-get-locate-index-file t)))
340 (unless (and filename (equal filename location)) 366 (unless (and filename (equal filename location))
341 (unless (equal (md5 (current-buffer)) 367 (unless (and location
342 (with-temp-buffer 368 (equal (md5 (current-buffer))
343 (insert-file-contents location) 369 (with-temp-buffer
344 (md5 (current-buffer)))) 370 (insert-file-contents-literally location)
345 (unless (file-writable-p location) 371 (md5 (current-buffer)))))
346 (setq location (expand-file-name package-get-base-filename 372 (unless (and location (file-writable-p location))
347 (expand-file-name "etc/" package-get-user-package-location)))) 373 (setq location package-get-user-index-filename))
348 (when (y-or-n-p (concat "Update package index in" location "? ")) 374 (when (y-or-n-p (concat "Update package index in " location "? "))
349 (write-file location)))))) 375 (write-file location))))))
350 376
351 377
352 ;;;###autoload 378 ;;;###autoload
353 (defun package-get-update-base (&optional db-file force-current) 379 (defun package-get-update-base (&optional db-file force-current)
423 (yes-or-no-p 449 (yes-or-no-p
424 (concat "Can't find PGP, continue without " 450 (concat "Can't find PGP, continue without "
425 "package-get DB verification? "))))) 451 "package-get DB verification? ")))))
426 (t nil))))) 452 (t nil)))))
427 (error "Package-get PGP signature failed to verify")) 453 (error "Package-get PGP signature failed to verify"))
428 ;; ToDo: We shoud call package-get-maybe-save-index on the region 454 ;; ToDo: We should call package-get-maybe-save-index on the region
429 (package-get-update-base-entries content-beg content-end) 455 (package-get-update-base-entries content-beg content-end)
430 (message "Updated package-get database")))) 456 (message "Updated package-get database"))))
431 457
432 (defun package-get-update-base-entries (beg end) 458 (defun package-get-update-base-entries (beg end)
433 "Update the package-get database with the entries found between 459 "Update the package-get database with the entries found between
999 (setq found 1025 (setq found
1000 (list (caar packages) 1026 (list (caar packages)
1001 (package-get-info-prop (car this-package) 'version)))) 1027 (package-get-info-prop (car this-package) 'version))))
1002 (setq this-package (cdr this-package))))) 1028 (setq this-package (cdr this-package)))))
1003 (setq packages (cdr packages))) 1029 (setq packages (cdr packages)))
1030 (when (interactive-p)
1031 (if found
1032 (message "%S" found)
1033 (message "No appropriate package found")))
1004 found)) 1034 found))
1005 1035
1006 ;; 1036 ;;
1007 ;; customize interfaces. 1037 ;; customize interfaces.
1008 ;; The group is in this file so that custom loads includes this file. 1038 ;; The group is in this file so that custom loads includes this file.