Mercurial > hg > xemacs-beta

comparison lisp/package-get.el @ 294:4b85ae5eabfb r21-0b45

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b45
author cvs
date Mon, 13 Aug 2007 10:38:01 +0200
parents 6cb5e14cd98e
children 70ad99077275
comparison
equal deleted inserted replaced
293:403535bfea94 294:4b85ae5eabfb
177 Uses `package-get-base' to determine just what is required and what 177 Uses `package-get-base' to determine just what is required and what
178 package provides that functionality. If VERSION is nil, retrieves 178 package provides that functionality. If VERSION is nil, retrieves
179 latest version. Optional argument FETCHED-PACKAGES is used to keep 179 latest version. Optional argument FETCHED-PACKAGES is used to keep
180 track of packages already fetched." 180 track of packages already fetched."
181 (interactive "sPackage: \nsVersion: ") 181 (interactive "sPackage: \nsVersion: ")
182 (load "package-get-base.el")
182 (let* ((the-package (package-get-info-find-package package-get-base 183 (let* ((the-package (package-get-info-find-package package-get-base
183 package)) 184 package))
184 (this-package (package-get-info-version 185 (this-package (package-get-info-version
185 the-package version)) 186 the-package version))
186 (this-requires (package-get-info-prop this-package 'requires)) 187 (this-requires (package-get-info-prop this-package 'requires))
206 (error "Unable to find a provider for %s" (car this-requires))) 207 (error "Unable to find a provider for %s" (car this-requires)))
207 (setq fetched-packages 208 (setq fetched-packages
208 (package-get-all reqd-name reqd-version fetched-packages))) 209 (package-get-all reqd-name reqd-version fetched-packages)))
209 ) 210 )
210 (setq this-requires (cdr this-requires))) 211 (setq this-requires (cdr this-requires)))
211 fetched-packages 212 fetched-packages
212 )) 213 ))
213 214
214 ;;;###autoload 215 ;;;###autoload
215 (defun package-get (package &optional version conflict) 216 (defun package-get (package &optional version conflict)
216 "Fetch PACKAGE from remote site. 217 "Fetch PACKAGE from remote site.
217 Optional arguments VERSION indicates which version to retrieve, nil 218 Optional arguments VERSION indicates which version to retrieve, nil
227 228
228 Once the package is retrieved, its md5 checksum is computed. If that 229 Once the package is retrieved, its md5 checksum is computed. If that
229 sum does not match that stored in `package-get-base' for this version 230 sum does not match that stored in `package-get-base' for this version
230 of the package, an error is signalled." 231 of the package, an error is signalled."
231 (interactive "xPackage List: ") 232 (interactive "xPackage List: ")
233 (load "package-get-base.el")
232 (let* ((this-package 234 (let* ((this-package
233 (package-get-info-version 235 (package-get-info-version
234 (package-get-info-find-package package-get-base 236 (package-get-info-find-package package-get-base
235 package) version)) 237 package) version))
236 (found nil) 238 (found nil)
250 ;; the checksum. Finally, install the package. 252 ;; the checksum. Finally, install the package.
251 (while (and search-dirs 253 (while (and search-dirs
252 (not (file-exists-p (package-get-staging-dir filename)))) 254 (not (file-exists-p (package-get-staging-dir filename))))
253 (if (file-exists-p (package-get-remote-filename 255 (if (file-exists-p (package-get-remote-filename
254 (car search-dirs) filename)) 256 (car search-dirs) filename))
255 (copy-file (package-get-remote-filename (car search-dirs) filename) 257 (copy-file (package-get-remote-filename (car search-dirs) filename)
256 (package-get-staging-dir filename)) 258 (package-get-staging-dir filename))
257 (setq search-dirs (cdr search-dirs)) 259 (setq search-dirs (cdr search-dirs))
258 )) 260 ))
259 (if (not (file-exists-p (package-get-staging-dir filename))) 261 (if (not (file-exists-p (package-get-staging-dir filename)))
260 (error "Unable to find file %s" filename)) 262 (error "Unable to find file %s" filename))
261 ;; Validate the md5 checksum 263 ;; Validate the md5 checksum
262 ;; Doing it with XEmacs removes the need for an external md5 program 264 ;; Doing it with XEmacs removes the need for an external md5 program
263 (with-temp-buffer 265 (with-temp-buffer
264 ; What ever happened to i-f-c-literally 266 ;; What ever happened to i-f-c-literally
265 (let (file-name-handler-alist) 267 (let (file-name-handler-alist)
266 (insert-file-contents-internal (package-get-staging-dir filename))) 268 (insert-file-contents-internal (package-get-staging-dir filename)))
267 (if (not (string= (md5 (current-buffer)) 269 (if (not (string= (md5 (current-buffer))
268 (package-get-info-prop this-package 270 (package-get-info-prop this-package
269 'md5sum))) 271 'md5sum)))
281 (if (and found package-get-remove-copy) 283 (if (and found package-get-remove-copy)
282 (delete-file (package-get-staging-dir filename))) 284 (delete-file (package-get-staging-dir filename)))
283 )) 285 ))
284 286
285 (defun package-get-info-find-package (which name) 287 (defun package-get-info-find-package (which name)
286 "Look in WHICH for the packaged called NAME and return all the info 288 "Look in WHICH for the package called NAME and return all the info
287 associated with it. See `package-get-base' for info on the format 289 associated with it. See `package-get-base' for info on the format
288 returned. 290 returned.
289 291
290 To access fields returned from this, use 292 To access fields returned from this, use
291 `package-get-info-version' to return information about particular a 293 `package-get-info-version' to return information about particular a
292 version. Use `package-get-info-find-prop' to find particular property 294 version. Use `package-get-info-find-prop' to find particular property
293 from a version returned by `package-get-info-version'." 295 from a version returned by `package-get-info-version'."
294 (interactive "xPackage list: sPackage Name: ") 296 (interactive "xPackage list: \nsPackage Name: ")
295 (if which 297 (if which
296 (if (eq (caar which) name) 298 (if (eq (caar which) name)
297 (cdar which) 299 (cdar which)
298 (if (cdr which) 300 (if (cdr which)
299 (package-get-info-find-package (cdr which) name))))) 301 (package-get-info-find-package (cdr which) name)))))
369 (defun package-get-installedp (package version) 371 (defun package-get-installedp (package version)
370 "Determine if PACKAGE with VERSION has already been installed. 372 "Determine if PACKAGE with VERSION has already been installed.
371 I'm not sure if I want to do this by searching directories or checking 373 I'm not sure if I want to do this by searching directories or checking
372 some built in variables. For now, use packages-package-list." 374 some built in variables. For now, use packages-package-list."
373 ;; Use packages-package-list which contains name and version 375 ;; Use packages-package-list which contains name and version
374 (equal (plist-get 376 (equal (plist-get
375 (package-get-info-find-package packages-package-list 377 (package-get-info-find-package packages-package-list
376 package) ':version) 378 package) ':version)
377 (if (floatp version) version (string-to-number version)))) 379 (if (floatp version) version (string-to-number version))))
378 380
381 ;;;###autoload
379 (defun package-get-package-provider (sym) 382 (defun package-get-package-provider (sym)
380 "Search for a package that provides SYM and return the name and 383 "Search for a package that provides SYM and return the name and
381 version. Searches in `package-get-base' for SYM. If SYM is a 384 version. Searches in `package-get-base' for SYM. If SYM is a
382 consp, then it must match a corresponding (provide (SYM VERSION)) from 385 consp, then it must match a corresponding (provide (SYM VERSION)) from
383 the package." 386 the package."
384 (interactive "SSymbol: ") 387 (interactive "SSymbol: ")
388 (load "package-get-base.el")
385 (let ((packages package-get-base) 389 (let ((packages package-get-base)
386 (done nil) 390 (done nil)
387 (found nil)) 391 (found nil))
388 (while (and (not done) packages) 392 (while (and (not done) packages)
389 (let* ((this-name (caar packages)) 393 (let* ((this-name (caar packages))
482 "-package nil \n" 486 "-package nil \n"
483 " \"" (plist-get (car (cdr pkg)) 'description) "\"\n" 487 " \"" (plist-get (car (cdr pkg)) 'description) "\"\n"
484 " :group '" category "-packages\n" 488 " :group '" category "-packages\n"
485 " :initialize 'package-get-ever-installed-p\n" 489 " :initialize 'package-get-ever-installed-p\n"
486 " :type 'boolean)\n\n") custom-buffer))) 490 " :type 'boolean)\n\n") custom-buffer)))
487 package-get-base) custom-buffer) 491 package-get-base) custom-buffer)
488 ) 492 )
489 493
490 ;; need this first to avoid infinite dependency loops 494 ;; need this first to avoid infinite dependency loops
491 (provide 'package-get) 495 (provide 'package-get)
492 496