Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 316:512e409c26a2 r21-0b56

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b56
author cvs
date Mon, 13 Aug 2007 10:44:46 +0200
parents 341dac730539
children afd57c14dfc8
comparison
equal deleted inserted replaced
315:5e87bc5b1ee4 316:512e409c26a2
326 (throw 'done nil)) 326 (throw 'done nil))
327 (setq dirs (cdr dirs)) 327 (setq dirs (cdr dirs))
328 ) 328 )
329 t)) 329 t))
330 (setq load-path (cons lispdir load-path))) 330 (setq load-path (cons lispdir load-path)))
331 (package-get-load-package-file lispdir "auto-autoloads") 331 (if (not (package-get-load-package-file lispdir "auto-autoloads"))
332 (package-get-load-package-file lispdir "_pkg"))
332 t) 333 t)
333 nil) 334 nil)
334 )) 335 ))
335 336
336 ;;;###autoload 337 ;;;###autoload
377 378
378 ;; Contrive a list of possible package filenames. 379 ;; Contrive a list of possible package filenames.
379 ;; Ugly. Is there a better way to do this? 380 ;; Ugly. Is there a better way to do this?
380 (setq filenames (cons base-filename nil)) 381 (setq filenames (cons base-filename nil))
381 (if (string-match "^\\(..*\\)\.tar\.gz$" base-filename) 382 (if (string-match "^\\(..*\\)\.tar\.gz$" base-filename)
382 (setq filenames (cons (concat (match-string 1 base-filename) ".tgz") 383 (setq filenames (append filenames
383 filenames))) 384 (list (concat (match-string 1 base-filename)
385 ".tgz")))))
384 386
385 (setq version (package-get-info-prop this-package 'version)) 387 (setq version (package-get-info-prop this-package 'version))
386 (unless (and (eq conflict 'never) 388 (unless (and (eq conflict 'never)
387 (package-get-installedp package version)) 389 (package-get-installedp package version))
388 ;; Find the package from the search list in package-get-remote 390 ;; Find the package from the search list in package-get-remote
389 ;; and copy it into the staging directory. Then validate 391 ;; and copy it into the staging directory. Then validate
390 ;; the checksum. Finally, install the package. 392 ;; the checksum. Finally, install the package.
391 (catch 'done 393 (catch 'done
392 (let (search-filenames current-dir-entry host dir current-filename) 394 (let (search-filenames current-dir-entry host dir current-filename
395 dest-filename)
393 ;; In each search directory ... 396 ;; In each search directory ...
394 (while search-dirs 397 (while search-dirs
395 (setq current-dir-entry (car search-dirs) 398 (setq current-dir-entry (car search-dirs)
396 host (car current-dir-entry) 399 host (car current-dir-entry)
397 dir (car (cdr current-dir-entry)) 400 dir (car (cdr current-dir-entry))
398 search-filenames filenames) 401 search-filenames filenames
402 )
399 403
400 ;; Look for one of the possible package filenames ... 404 ;; Look for one of the possible package filenames ...
401 (while search-filenames 405 (while search-filenames
402 (setq current-filename (car search-filenames)) 406 (setq current-filename (car search-filenames)
403 (if (null host) 407 dest-filename (package-get-staging-dir current-filename))
404 (progn 408 (cond
405 ;; No host means look on the current system. 409 ;; No host means look on the current system.
406 (setq full-package-filename 410 ( (null host)
407 (substitute-in-file-name 411 (setq full-package-filename
408 (expand-file-name current-filename 412 (substitute-in-file-name
409 (file-name-as-directory dir)))) 413 (expand-file-name current-filename
410 ) 414 (file-name-as-directory dir))))
411 ;; If the file exists on the remote system ... 415 )
412 (if (file-exists-p (package-get-remote-filename 416
413 current-dir-entry current-filename)) 417 ;; If it's already on the disk locally, and the size is
414 (progn 418 ;; greater than zero ...
415 ;; Get it 419 ( (and (file-exists-p dest-filename)
416 (setq full-package-filename 420 (let (attrs)
417 (package-get-staging-dir current-filename)) 421 ;; file-attributes could return -1 for LARGE files,
418 (message "Retrieving package `%s' ..." 422 ;; but, hopefully, packages won't be that large.
419 current-filename) 423 (and (setq attrs (file-attributes dest-filename))
420 (sit-for 0) 424 (> (nth 7 attrs) 0))))
421 (copy-file (package-get-remote-filename current-dir-entry 425 (setq full-package-filename dest-filename)
422 current-filename) 426 )
423 )))) 427
428 ;; If the file exists on the remote system ...
429 ( (file-exists-p (package-get-remote-filename
430 current-dir-entry current-filename))
431 ;; Get it
432 (setq full-package-filename dest-filename)
433 (message "Retrieving package `%s' ..."
434 current-filename)
435 (sit-for 0)
436 (copy-file (package-get-remote-filename current-dir-entry
437 current-filename)
438 full-package-filename t)
439 )
440 )
441
424 ;; If we found it, we're done. 442 ;; If we found it, we're done.
425 (if (file-exists-p full-package-filename) 443 (if (and full-package-filename
444 (file-exists-p full-package-filename))
426 (throw 'done nil)) 445 (throw 'done nil))
427 ;; Didn't find it. Try the next possible filename. 446 ;; Didn't find it. Try the next possible filename.
428 (setq search-filenames (cdr search-filenames)) 447 (setq search-filenames (cdr search-filenames))
429 ) 448 )
430 ;; Try looking in the next possible directory ... 449 ;; Try looking in the next possible directory ...