Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 329:58bac07dfa74 r21-0-62

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0-62
author cvs
date Mon, 13 Aug 2007 10:48:41 +0200
parents 03446687b7cc
children 4f79e16b1112
comparison
equal deleted inserted replaced
328:2229f69ea3e0 329:58bac07dfa74
196 ("cenatls.cena.dgac.fr" "ftp.cenatls.cena.dgac.fr" "pub/Emacs/xemacs/packages") 196 ("cenatls.cena.dgac.fr" "ftp.cenatls.cena.dgac.fr" "pub/Emacs/xemacs/packages")
197 ("kfki.hu" "ftp.kfki.hu" "pub/packages/xemacs/packages") 197 ("kfki.hu" "ftp.kfki.hu" "pub/packages/xemacs/packages")
198 ("uniroma2.it" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages") 198 ("uniroma2.it" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages")
199 ("icm.edu.pl" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages") 199 ("icm.edu.pl" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages")
200 ("sunet.se" "ftp.sunet.se" "pub/gnu/xemacs/packages") 200 ("sunet.se" "ftp.sunet.se" "pub/gnu/xemacs/packages")
201 ("doc.ic.ac.uk" "ftp.doc.ic.ac.uk" "packages/xemacs/packages") 201 ("doc.ic.ac.uk" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages")
202 ("srcc.msu.su" "ftp1.srcc.msu.su" "mirror/ftp.xemacs.org/packages") 202 ("srcc.msu.su" "ftp1.srcc.msu.su" "mirror/ftp.xemacs.org/packages")
203 203
204 ;; Asia 204 ;; Asia
205 ("usyd.edu.au" "ftp.usyd.edu.au" "pub/Xemacs/packages") 205 ("usyd.edu.au" "ftp.usyd.edu.au" "pub/Xemacs/packages")
206 ("netlab.is.tsukuba.ac.jp" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages") 206 ("netlab.is.tsukuba.ac.jp" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages")
259 ;;;###autoload 259 ;;;###autoload
260 (defun package-get-download-menu () 260 (defun package-get-download-menu ()
261 "Build the `Add Download Site' menu." 261 "Build the `Add Download Site' menu."
262 (mapcar (lambda (site) 262 (mapcar (lambda (site)
263 (vector (car site) 263 (vector (car site)
264 `(lambda () 264 `(package-ui-add-site (quote ,(cdr site)))
265 (interactive) (package-ui-add-site (quote ,(cdr site))))
266 :style 'toggle :selected 265 :style 'toggle :selected
267 `(member (quote ,(cdr site)) package-get-remote))) 266 `(member (quote ,(cdr site)) package-get-remote)))
268 package-get-download-sites)) 267 package-get-download-sites))
269 268
270 ;;;###autoload 269 ;;;###autoload
322 (setq entries (cdr entries))) 321 (setq entries (cdr entries)))
323 (or expanded 322 (or expanded
324 (and (not nil-if-not-found) 323 (and (not nil-if-not-found)
325 file))))) 324 file)))))
326 325
327 (defun package-get-locate-index-file (force-current) 326 (defun package-get-locate-index-file (no-remote)
328 "Locate the package-get index file. 327 "Locate the package-get index file. Do not return remote paths if NO-REMOTE
329 If FORCE-CURRENT is non-nil, require a current copy to be found." 328 is non-nil."
330 (when (and force-current (not package-get-remote)) 329 (or (package-get-locate-file package-get-base-filename t no-remote)
331 (error "No remote package sites specified in `package-get-remote'"))
332 (or (package-get-locate-file package-get-base-filename t (not force-current))
333 (locate-data-file package-get-base-filename) 330 (locate-data-file package-get-base-filename)
334 package-get-base-filename)) 331 package-get-base-filename))
335 332
336 (defvar package-get-user-package-location user-init-directory) 333 (defvar package-get-user-package-location user-init-directory)
337 334
338 (defun package-get-maybe-save-index (filename) 335 (defun package-get-maybe-save-index (filename)
339 "Offer to save the current buffer as the local package index file, 336 "Offer to save the current buffer as the local package index file,
340 if different." 337 if different."
341 (let ((location (package-get-locate-index-file nil))) 338 (let ((location (package-get-locate-index-file t)))
342 (unless (and filename (equal filename location)) 339 (unless (and filename (equal filename location))
343 (unless (equal (md5 (current-buffer)) 340 (unless (equal (md5 (current-buffer))
344 (with-temp-buffer 341 (with-temp-buffer
345 (insert-file-contents location) 342 (insert-file-contents location)
346 (md5 (current-buffer)))) 343 (md5 (current-buffer))))
354 ;;;###autoload 351 ;;;###autoload
355 (defun package-get-update-base (&optional db-file force-current) 352 (defun package-get-update-base (&optional db-file force-current)
356 "Update the package-get database file with entries from DB-FILE. 353 "Update the package-get database file with entries from DB-FILE.
357 Unless FORCE-CURRENT is non-nil never try to update the database." 354 Unless FORCE-CURRENT is non-nil never try to update the database."
358 (interactive 355 (interactive
359 (let ((dflt (package-get-locate-index-file t))) 356 (let ((dflt (package-get-locate-index-file nil)))
360 (list (read-file-name "Load package-get database: " 357 (list (read-file-name "Load package-get database: "
361 (file-name-directory dflt) 358 (file-name-directory dflt)
362 dflt 359 dflt
363 t 360 t
364 (file-name-nondirectory dflt))))) 361 (file-name-nondirectory dflt)))))
365 (setq db-file (expand-file-name (or db-file 362 (setq db-file (expand-file-name (or db-file
366 (package-get-locate-index-file 363 (package-get-locate-index-file
367 force-current)))) 364 (not force-current)))))
368 (if (not (file-exists-p db-file)) 365 (if (not (file-exists-p db-file))
369 (error "Package-get database file `%s' does not exist" db-file)) 366 (error "Package-get database file `%s' does not exist" db-file))
370 (if (not (file-readable-p db-file)) 367 (if (not (file-readable-p db-file))
371 (error "Package-get database file `%s' not readable" db-file)) 368 (error "Package-get database file `%s' not readable" db-file))
372 (let ((buf (get-buffer-create "*package database*"))) 369 (let ((buf (get-buffer-create "*package database*")))