Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 327:03446687b7cc r21-0-61

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0-61
author cvs
date Mon, 13 Aug 2007 10:48:16 +0200
parents f2b5d7006b0a
children 58bac07dfa74
comparison
equal deleted inserted replaced
326:e2671bc7f66a 327:03446687b7cc
252 :group 'package-get) 252 :group 'package-get)
253 253
254 (defvar package-get-was-current nil 254 (defvar package-get-was-current nil
255 "Non-nil we did our best to fetch a current database.") 255 "Non-nil we did our best to fetch a current database.")
256 256
257
258 ;Shouldn't this be in package-ui?
257 ;;;###autoload 259 ;;;###autoload
258 (defun package-get-download-menu () 260 (defun package-get-download-menu ()
259 "Build the `Add Download Site' menu." 261 "Build the `Add Download Site' menu."
260 (mapcar (lambda (site) 262 (mapcar (lambda (site)
261 (vector (car site) 263 (vector (car site)
262 `(push (quote ,(cdr site)) 264 `(lambda ()
263 package-get-remote))) 265 (interactive) (package-ui-add-site (quote ,(cdr site))))
266 :style 'toggle :selected
267 `(member (quote ,(cdr site)) package-get-remote)))
264 package-get-download-sites)) 268 package-get-download-sites))
265 269
266 ;;;###autoload 270 ;;;###autoload
267 (defun package-get-require-base (&optional force-current) 271 (defun package-get-require-base (&optional force-current)
268 "Require that a package-get database has been loaded. 272 "Require that a package-get database has been loaded.
703 (search-dirs package-get-remote) 707 (search-dirs package-get-remote)
704 (base-filename (package-get-info-prop this-package 'filename)) 708 (base-filename (package-get-info-prop this-package 'filename))
705 (package-status t) 709 (package-status t)
706 filenames full-package-filename) 710 filenames full-package-filename)
707 (if (null this-package) 711 (if (null this-package)
708 (error "Couldn't find package %s with version %s" 712 (if package-get-remote
709 package version)) 713 (error "Couldn't find package %s with version %s"
714 package version)
715 (error "No download sites or local package locations specified.")))
710 (if (null base-filename) 716 (if (null base-filename)
711 (error "No filename associated with package %s, version %s" 717 (error "No filename associated with package %s, version %s"
712 package version)) 718 package version))
713 (setq install-dir 719 (setq install-dir
714 (package-admin-get-install-dir package install-dir 720 (package-admin-get-install-dir package install-dir
805 ) 811 )
806 )) 812 ))
807 813
808 (if (or (not full-package-filename) 814 (if (or (not full-package-filename)
809 (not (file-exists-p full-package-filename))) 815 (not (file-exists-p full-package-filename)))
810 (error "Unable to find file %s" base-filename)) 816 (if package-get-remote
817 (error "Unable to find file %s" base-filename)
818 (error
819 "No download sites or local package locations specified.")))
811 ;; Validate the md5 checksum 820 ;; Validate the md5 checksum
812 ;; Doing it with XEmacs removes the need for an external md5 program 821 ;; Doing it with XEmacs removes the need for an external md5 program
813 (message "Validating checksum for `%s'..." package) (sit-for 0) 822 (message "Validating checksum for `%s'..." package) (sit-for 0)
814 (with-temp-buffer 823 (with-temp-buffer
815 ;; What ever happened to i-f-c-literally 824 ;; What ever happened to i-f-c-literally
938 site-name:remote-directory/filename 947 site-name:remote-directory/filename
939 " 948 "
940 (if (efs-ftp-path filename) 949 (if (efs-ftp-path filename)
941 filename 950 filename
942 (let ((dir (cadr search))) 951 (let ((dir (cadr search)))
943 (concat "/" 952 (concat (if (string-match "@" (car search))
953 "/"
954 "/anonymous@")
944 (car search) ":" 955 (car search) ":"
945 (if (string-match "/$" dir) 956 (if (string-match "/$" dir)
946 dir 957 dir
947 (concat dir "/")) 958 (concat dir "/"))
948 filename)))) 959 filename))))