Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 424:11054d720c21 r21-2-20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 697ef44129c6
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
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 ("cso.uiuc.edu" "ftp.cso.uiuc.edu" "pub/packages/xemacs/packages")
237 This may either be a relative path, in which case it is interpreted 238 This may either be a relative path, in which case it is interpreted
238 with respect to `package-get-remote', or an absolute path." 239 with respect to `package-get-remote', or an absolute path."
239 :type 'file 240 :type 'file
240 :group 'package-get) 241 :group 'package-get)
241 242
243 (defvar package-get-user-index-filename
244 (paths-construct-path (list user-init-directory package-get-base-filename))
245 "Name for the user-specific location of the package-get database file.")
246
242 (defcustom package-get-always-update nil 247 (defcustom package-get-always-update nil
243 "*If Non-nil always make sure we are using the latest package index (base). 248 "*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'." 249 Otherwise respect the `force-current' argument of `package-get-require-base'."
245 :type 'boolean 250 :type 'boolean
246 :group 'package-get) 251 :group 'package-get)
259 ;Shouldn't this be in package-ui? 264 ;Shouldn't this be in package-ui?
260 ;;;###autoload 265 ;;;###autoload
261 (defun package-get-download-menu () 266 (defun package-get-download-menu ()
262 "Build the `Add Download Site' menu." 267 "Build the `Add Download Site' menu."
263 (mapcar (lambda (site) 268 (mapcar (lambda (site)
264 (vector (car site) 269 (vector (car site)
265 `(package-ui-add-site (quote ,(cdr site))) 270 `(if (member (quote ,(cdr site))
266 :style 'toggle :selected 271 package-get-remote)
267 `(member (quote ,(cdr site)) package-get-remote))) 272 (setq package-get-remote
268 package-get-download-sites)) 273 (delete (quote ,(cdr site)) package-get-remote))
274 (package-ui-add-site (quote ,(cdr site))))
275 :style 'toggle
276 :selected `(member (quote ,(cdr site))
277 package-get-remote)))
278 package-get-download-sites))
269 279
270 ;;;###autoload 280 ;;;###autoload
271 (defun package-get-require-base (&optional force-current) 281 (defun package-get-require-base (&optional force-current)
272 "Require that a package-get database has been loaded. 282 "Require that a package-get database has been loaded.
273 If the optional FORCE-CURRENT argument or the value of 283 If the optional FORCE-CURRENT argument or the value of
326 336
327 (defun package-get-locate-index-file (no-remote) 337 (defun package-get-locate-index-file (no-remote)
328 "Locate the package-get index file. Do not return remote paths if NO-REMOTE 338 "Locate the package-get index file. Do not return remote paths if NO-REMOTE
329 is non-nil." 339 is non-nil."
330 (or (package-get-locate-file package-get-base-filename t no-remote) 340 (or (package-get-locate-file package-get-base-filename t no-remote)
331 (locate-data-file package-get-base-filename) 341 (if (file-exists-p package-get-user-index-filename)
332 package-get-base-filename)) 342 package-get-user-index-filename)))
333
334 (defvar package-get-user-package-location user-init-directory)
335 343
336 (defun package-get-maybe-save-index (filename) 344 (defun package-get-maybe-save-index (filename)
337 "Offer to save the current buffer as the local package index file, 345 "Offer to save the current buffer as the local package index file,
338 if different." 346 if different."
339 (let ((location (package-get-locate-index-file t))) 347 (let ((location (package-get-locate-index-file t)))
340 (unless (and filename (equal filename location)) 348 (unless (and filename (equal filename location))
341 (unless (equal (md5 (current-buffer)) 349 (unless (and location
342 (with-temp-buffer 350 (equal (md5 (current-buffer))
343 (insert-file-contents location) 351 (with-temp-buffer
344 (md5 (current-buffer)))) 352 (insert-file-contents-literally location)
345 (unless (file-writable-p location) 353 (md5 (current-buffer)))))
346 (setq location (expand-file-name package-get-base-filename 354 (unless (and location (file-writable-p location))
347 (expand-file-name "etc/" package-get-user-package-location)))) 355 (setq location package-get-user-index-filename))
348 (when (y-or-n-p (concat "Update package index in" location "? ")) 356 (when (y-or-n-p (concat "Update package index in" location "? "))
349 (write-file location)))))) 357 (write-file location))))))
350 358
351 359
352 ;;;###autoload 360 ;;;###autoload
999 (setq found 1007 (setq found
1000 (list (caar packages) 1008 (list (caar packages)
1001 (package-get-info-prop (car this-package) 'version)))) 1009 (package-get-info-prop (car this-package) 'version))))
1002 (setq this-package (cdr this-package))))) 1010 (setq this-package (cdr this-package)))))
1003 (setq packages (cdr packages))) 1011 (setq packages (cdr packages)))
1012 (when (interactive-p)
1013 (if found
1014 (message "%S" found)
1015 (message "No appropriate package found")))
1004 found)) 1016 found))
1005 1017
1006 ;; 1018 ;;
1007 ;; customize interfaces. 1019 ;; customize interfaces.
1008 ;; The group is in this file so that custom loads includes this file. 1020 ;; The group is in this file so that custom loads includes this file.