Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 325:f2b5d7006b0a r21-0-60

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0-60
author cvs
date Mon, 13 Aug 2007 10:47:35 +0200
parents 19dcec799385
children 03446687b7cc
comparison
equal deleted inserted replaced
324:8f2460f6e1f6 325:f2b5d7006b0a
318 (setq entries (cdr entries))) 318 (setq entries (cdr entries)))
319 (or expanded 319 (or expanded
320 (and (not nil-if-not-found) 320 (and (not nil-if-not-found)
321 file))))) 321 file)))))
322 322
323 (defun package-get-locate-index-file (no-remote) 323 (defun package-get-locate-index-file (force-current)
324 "Locate the package-get index file. Do not return remote paths if NO-REMOTE 324 "Locate the package-get index file.
325 is non-nil." 325 If FORCE-CURRENT is non-nil, require a current copy to be found."
326 (or (package-get-locate-file package-get-base-filename t no-remote) 326 (when (and force-current (not package-get-remote))
327 (error "No remote package sites specified in `package-get-remote'"))
328 (or (package-get-locate-file package-get-base-filename t (not force-current))
327 (locate-data-file package-get-base-filename) 329 (locate-data-file package-get-base-filename)
328 package-get-base-filename)) 330 package-get-base-filename))
329 331
330 (defvar package-get-user-package-location user-init-directory) 332 (defvar package-get-user-package-location user-init-directory)
331 333
332 (defun package-get-maybe-save-index (filename) 334 (defun package-get-maybe-save-index (filename)
333 "Offer to save the current buffer as the local package index file, 335 "Offer to save the current buffer as the local package index file,
334 if different." 336 if different."
335 (let ((location (package-get-locate-index-file t))) 337 (let ((location (package-get-locate-index-file nil)))
336 (unless (and filename (equal filename location)) 338 (unless (and filename (equal filename location))
337 (unless (equal (md5 (current-buffer)) 339 (unless (equal (md5 (current-buffer))
338 (with-temp-buffer 340 (with-temp-buffer
339 (insert-file-contents location) 341 (insert-file-contents location)
340 (md5 (current-buffer)))) 342 (md5 (current-buffer))))
348 ;;;###autoload 350 ;;;###autoload
349 (defun package-get-update-base (&optional db-file force-current) 351 (defun package-get-update-base (&optional db-file force-current)
350 "Update the package-get database file with entries from DB-FILE. 352 "Update the package-get database file with entries from DB-FILE.
351 Unless FORCE-CURRENT is non-nil never try to update the database." 353 Unless FORCE-CURRENT is non-nil never try to update the database."
352 (interactive 354 (interactive
353 (let ((dflt (package-get-locate-index-file nil))) 355 (let ((dflt (package-get-locate-index-file t)))
354 (list (read-file-name "Load package-get database: " 356 (list (read-file-name "Load package-get database: "
355 (file-name-directory dflt) 357 (file-name-directory dflt)
356 dflt 358 dflt
357 t 359 t
358 (file-name-nondirectory dflt))))) 360 (file-name-nondirectory dflt)))))
359 (setq db-file (expand-file-name (or db-file 361 (setq db-file (expand-file-name (or db-file
360 (package-get-locate-index-file 362 (package-get-locate-index-file
361 (not force-current))))) 363 force-current))))
362 (if (not (file-exists-p db-file)) 364 (if (not (file-exists-p db-file))
363 (error "Package-get database file `%s' does not exist" db-file)) 365 (error "Package-get database file `%s' does not exist" db-file))
364 (if (not (file-readable-p db-file)) 366 (if (not (file-readable-p db-file))
365 (error "Package-get database file `%s' not readable" db-file)) 367 (error "Package-get database file `%s' not readable" db-file))
366 (let ((buf (get-buffer-create "*package database*"))) 368 (let ((buf (get-buffer-create "*package database*")))