Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 1483:410360d3e34e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-05-14 23:57:34 by youngs] 2003-05-15 Steve Youngs <youngs@xemacs.org> * package-get.el (package-get-package-index-file-location): New, so it is possible to specify a location for the index file. (package-get-locate-index-file): Use it. (package-get-maybe-save-index): Ditto. (package-get-user-index-filename): Remove.
author youngs
date Wed, 14 May 2003 23:57:35 +0000
parents 84d95f07cb42
children 6f4c71266175
comparison
equal deleted inserted replaced
1482:e849de92ffef 1483:410360d3e34e
164 one version of a package available.") 164 one version of a package available.")
165 165
166 (defcustom package-get-dir (temp-directory) 166 (defcustom package-get-dir (temp-directory)
167 "*Where to store temporary files for staging." 167 "*Where to store temporary files for staging."
168 :tag "Temporary directory" 168 :tag "Temporary directory"
169 :type 'directory
170 :group 'package-get)
171
172 ;;;###autoload
173 (defcustom package-get-package-index-file-location
174 (or (getenv "EMACSPACKAGEPATH")
175 user-init-directory)
176 "*The directory where the package-index file can be found."
169 :type 'directory 177 :type 'directory
170 :group 'package-get) 178 :group 'package-get)
171 179
172 ;;;###autoload 180 ;;;###autoload
173 (defcustom package-get-install-to-user-init-directory nil 181 (defcustom package-get-install-to-user-init-directory nil
370 This may either be a relative path, in which case it is interpreted 378 This may either be a relative path, in which case it is interpreted
371 with respect to `package-get-remote', or an absolute path." 379 with respect to `package-get-remote', or an absolute path."
372 :type 'file 380 :type 'file
373 :group 'package-get) 381 :group 'package-get)
374 382
375 (defvar package-get-user-index-filename
376 (paths-construct-path (list user-init-directory package-get-base-filename))
377 "Name for the user-specific location of the package-get database file.")
378
379 (defcustom package-get-always-update nil 383 (defcustom package-get-always-update nil
380 "*If Non-nil always make sure we are using the latest package index (base). 384 "*If Non-nil always make sure we are using the latest package index (base).
381 Otherwise respect the `force-current' argument of `package-get-require-base'." 385 Otherwise respect the `force-current' argument of `package-get-require-base'."
382 :type 'boolean 386 :type 'boolean
383 :group 'package-get) 387 :group 'package-get)
487 (or expanded 491 (or expanded
488 (and (not nil-if-not-found) 492 (and (not nil-if-not-found)
489 file))))) 493 file)))))
490 494
491 (defun package-get-locate-index-file (no-remote) 495 (defun package-get-locate-index-file (no-remote)
492 "Locate the package-get index file. Do not return remote paths if NO-REMOTE 496 "Locate the package-get index file.
493 is non-nil." 497
498 Do not return remote paths if NO-REMOTE is non-nil. If the index
499 file doesn't exist in `package-get-package-index-file-location', ask
500 the user if one should be created using the index file in core as a
501 template."
494 (or (package-get-locate-file package-get-base-filename t no-remote) 502 (or (package-get-locate-file package-get-base-filename t no-remote)
495 (if (file-exists-p package-get-user-index-filename) 503 (if (file-exists-p (expand-file-name package-get-base-filename
496 package-get-user-index-filename) 504 package-get-package-index-file-location))
497 (locate-data-file package-get-base-filename) 505 (expand-file-name package-get-base-filename
498 (error 'search-failed 506 package-get-package-index-file-location)
499 "Can't locate a package index file."))) 507 (if (y-or-n-p (format "No index file, shall I create one in %s? "
508 package-get-package-index-file-location))
509 (progn
510 (save-excursion
511 (set-buffer
512 (find-file-noselect (expand-file-name
513 package-get-base-filename
514 package-get-package-index-file-location)))
515 (let ((coding-system-for-write 'binary))
516 (erase-buffer)
517 (insert-file-contents-literally
518 (locate-data-file package-get-base-filename))
519 (save-buffer (current-buffer))
520 (kill-buffer (current-buffer))))
521 (expand-file-name package-get-base-filename
522 package-get-package-index-file-location))
523 (error 'search-failed
524 "Can't locate a package index file.")))))
500 525
501 (defun package-get-maybe-save-index (filename) 526 (defun package-get-maybe-save-index (filename)
502 "Offer to save the current buffer as the local package index file, 527 "Offer to save the current buffer as the local package index file,
503 if different." 528 if different."
504 (let ((location (package-get-locate-index-file t))) 529 (let ((location (package-get-locate-index-file t)))
506 (unless (and location 531 (unless (and location
507 (equal (md5 (current-buffer)) 532 (equal (md5 (current-buffer))
508 (with-temp-buffer 533 (with-temp-buffer
509 (insert-file-contents-literally location) 534 (insert-file-contents-literally location)
510 (md5 (current-buffer))))) 535 (md5 (current-buffer)))))
511 (unless (and location (file-writable-p location)) 536 (when (not (file-writable-p location))
512 (setq location package-get-user-index-filename)) 537 (if (y-or-n-p (format "Sorry, %s is read-only, can I use %s? "
538 location user-init-directory))
539 (setq location (expand-file-name
540 package-get-base-filename
541 package-get-package-index-file-location))
542 (error 'file-error
543 (format "%s is read-only" location))))
513 (when (y-or-n-p (concat "Update package index in " location "? ")) 544 (when (y-or-n-p (concat "Update package index in " location "? "))
514 (let ((coding-system-for-write 'binary)) 545 (let ((coding-system-for-write 'binary))
515 (write-file location))))))) 546 (write-file location)))))))
516 547
517 ;;;###autoload 548 ;;;###autoload