Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 237:89ec2bb86eea r20-5b17

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b17
author cvs
date Mon, 13 Aug 2007 10:15:03 +0200
parents 85a06df23a9a
children 727739f917cb
comparison
equal deleted inserted replaced
236:78d3ccccee6d 237:89ec2bb86eea
166 Uses `package-get-base' to determine just what is required and what 166 Uses `package-get-base' to determine just what is required and what
167 package provides that functionality. If VERSION is nil, retrieves 167 package provides that functionality. If VERSION is nil, retrieves
168 latest version. Optional argument FETCHED-PACKAGES is used to keep 168 latest version. Optional argument FETCHED-PACKAGES is used to keep
169 track of packages already fetched." 169 track of packages already fetched."
170 (interactive "sPackage: sVersion: ") 170 (interactive "sPackage: sVersion: ")
171 (let* ((this-package (package-get-info-version 171 (let* ((the-package (package-get-info-find-package package-get-base
172 (package-get-info-find-package package-get-base 172 package))
173 package) version)) 173 (this-package (package-get-info-version
174 the-package version))
174 (this-requires (package-get-info-prop this-package 'requires)) 175 (this-requires (package-get-info-prop this-package 'requires))
175 ) 176 )
177 (setq version (package-get-info-prop this-package 'version))
176 (unless (package-get-installedp package version) 178 (unless (package-get-installedp package version)
177 (package-get package version)) 179 (package-get package version))
178 (setq fetched-packages 180 (setq fetched-packages
179 (append (package-get-info-prop this-package 'provides) 181 (append (list package)
182 (package-get-info-prop this-package 'provides)
180 fetched-packages)) 183 fetched-packages))
181 ;; grab everything that this package requires plus recursively 184 ;; grab everything that this package requires plus recursively
182 ;; grab everything that the requires require. Keep track 185 ;; grab everything that the requires require. Keep track
183 ;; in `fetched-packages' the list of things provided -- this 186 ;; in `fetched-packages' the list of things provided -- this
184 ;; keeps us from going into a loop 187 ;; keeps us from going into a loop
186 (if (not (member (car this-requires) fetched-packages)) 189 (if (not (member (car this-requires) fetched-packages))
187 (let* ((reqd-package (package-get-package-provider 190 (let* ((reqd-package (package-get-package-provider
188 (car this-requires))) 191 (car this-requires)))
189 (reqd-version (cadr reqd-package)) 192 (reqd-version (cadr reqd-package))
190 (reqd-name (car reqd-package))) 193 (reqd-name (car reqd-package)))
194 (if (null reqd-name)
195 (error "Unable to find a provider for %s" (car this-requires)))
191 (setq fetched-packages 196 (setq fetched-packages
192 (package-get-all reqd-name reqd-version fetched-packages))) 197 (package-get-all reqd-name reqd-version fetched-packages)))
193 ) 198 )
194 (setq this-requires (cdr this-requires))) 199 (setq this-requires (cdr this-requires)))
195 fetched-packages 200 fetched-packages
223 (error "Couldn't find package %s with version %s" 228 (error "Couldn't find package %s with version %s"
224 package version)) 229 package version))
225 (if (null filename) 230 (if (null filename)
226 (error "No filename associated with package %s, version %s" 231 (error "No filename associated with package %s, version %s"
227 package version)) 232 package version))
228 233 (setq version (package-get-info-prop this-package 'version))
229 (unless (and (eq conflict 'never) 234 (unless (and (eq conflict 'never)
230 (package-get-installedp package version)) 235 (package-get-installedp package version))
231 ;; Find the package from search list in package-get-remote 236 ;; Find the package from search list in package-get-remote
232 ;; and copy it into the staging directory. Then validate 237 ;; and copy it into the staging directory. Then validate
233 ;; the checksum. Finally, install the package. 238 ;; the checksum. Finally, install the package.
250 (goto-char (point-min)) 255 (goto-char (point-min))
251 (looking-at "[a-z0-9]+") 256 (looking-at "[a-z0-9]+")
252 (if (not (string= (buffer-substring (match-beginning 0) (match-end 0)) 257 (if (not (string= (buffer-substring (match-beginning 0) (match-end 0))
253 (package-get-info-prop this-package 'md5sum))) 258 (package-get-info-prop this-package 'md5sum)))
254 (error "Package %s does not match md5 checksum" filename))) 259 (error "Package %s does not match md5 checksum" filename)))
255 (message "Retrieved package %s" filename) (sit-for 1) 260 (message "Retrieved package %s" filename) (sit-for 0)
256 (let ((status 261 (let ((status
257 (if (eq (package-get-info-prop this-package 'type) 'single) 262 (if (eq (package-get-info-prop this-package 'type) 'single)
258 (package-admin-add-single-file-package 263 (package-admin-add-single-file-package
259 (package-get-staging-dir filename)) 264 (package-get-staging-dir filename))
260 (package-admin-add-binary-package 265 (package-admin-add-binary-package
261 (package-get-staging-dir filename))))) 266 (package-get-staging-dir filename)))))
262 (when (not (= status 0)) 267 (when (not (= status 0))
263 (message "Package failed.") 268 (message "Package failed.")
264 (select-buffer package-admin-temp-buffer))) 269 (switch-to-buffer package-admin-temp-buffer)))
265 (sit-for 2) 270 (sit-for 0)
266 (message "Added package") (sit-for 1) 271 (message "Added package") (sit-for 0)
267 (setq found t)) 272 (setq found t))
268 (if (and found package-get-remove-copy) 273 (if (and found package-get-remove-copy)
269 (delete-file (package-get-staging-dir filename))) 274 (delete-file (package-get-staging-dir filename)))
270 )) 275 ))
271 276
370 (interactive "SSymbol: ") 375 (interactive "SSymbol: ")
371 (let ((packages package-get-base) 376 (let ((packages package-get-base)
372 (done nil) 377 (done nil)
373 (found nil)) 378 (found nil))
374 (while (and (not done) packages) 379 (while (and (not done) packages)
375 (let ((this-package (cdr (car packages)))) ;strip off package name 380 (let* ((this-name (caar packages))
381 (this-package (cdr (car packages)))) ;strip off package name
376 (while (and (not done) this-package) 382 (while (and (not done) this-package)
377 (if (member sym (package-get-info-prop (car this-package) 'provides)) 383 (if (or (eq this-name sym)
384 (eq (cons this-name
385 (package-get-info-prop (car this-package) 'version))
386 sym)
387 (member sym (package-get-info-prop (car this-package) 'provides)))
378 (progn (setq done t) 388 (progn (setq done t)
379 (setq found (list (caar packages) 389 (setq found (list (caar packages)
380 (package-get-info-prop (car this-package) 'version)))) 390 (package-get-info-prop (car this-package) 'version))))
381 (setq this-package (cdr this-package))))) 391 (setq this-package (cdr this-package)))))
382 (setq packages (cdr packages))) 392 (setq packages (cdr packages)))