comparison lisp/package-get.el @ 404:2f8bb876ab1d r21-2-32

Import from CVS: tag r21-2-32
author cvs
date Mon, 13 Aug 2007 11:16:07 +0200
parents a86b2b5e0111
children de805c49cfc1
comparison
equal deleted inserted replaced
403:9f011ab08d48 404:2f8bb876ab1d
66 ;; version: 2.0 66 ;; version: 2.0
67 ;; 67 ;;
68 ;; vm - a mail reader 68 ;; vm - a mail reader
69 ;; [] Always install 69 ;; [] Always install
70 ;; [] Needs updating 70 ;; [] Needs updating
71 ;; [] Required by other [packages] 71 ;; [] Required by other [packages]
72 ;; 72 ;;
73 ;; Where `[]' indicates a toggle box 73 ;; Where `[]' indicates a toggle box
74 ;; 74 ;;
75 ;; - Clicking on "Always install" puts this into 75 ;; - Clicking on "Always install" puts this into
76 ;; `package-get-here' list. "Needs updating" indicates a new 76 ;; `package-get-here' list. "Needs updating" indicates a new
77 ;; version is available. Anything already in 77 ;; version is available. Anything already in
78 ;; `package-get-here' has this enabled. 78 ;; `package-get-here' has this enabled.
79 ;; - "Required by other" means some other packages are going to force 79 ;; - "Required by other" means some other packages are going to force
80 ;; this to be installed. Clicking on [packages] gives a list 80 ;; this to be installed. Clicking on [packages] gives a list
81 ;; of packages that require this. 81 ;; of packages that require this.
82 ;; 82 ;;
83 ;; The `package-get-base' should be installed in a file in 83 ;; The `package-get-base' should be installed in a file in
84 ;; `data-directory'. The `package-get-here' should be installed in 84 ;; `data-directory'. The `package-get-here' should be installed in
85 ;; site-lisp. Both are then read at run time. 85 ;; site-lisp. Both are then read at run time.
86 ;; 86 ;;
87 ;; TODO: 87 ;; TODO:
111 (defgroup package-get nil 111 (defgroup package-get nil
112 "Automatic Package Fetcher and Installer." 112 "Automatic Package Fetcher and Installer."
113 :prefix "package-get" 113 :prefix "package-get"
114 :group 'package-tools) 114 :group 'package-tools)
115 115
116 ;;;###autoload 116 ;;;###autoload
117 (defvar package-get-base nil 117 (defvar package-get-base nil
118 "List of packages that are installed at this site. 118 "List of packages that are installed at this site.
119 For each element in the alist, car is the package name and the cdr is 119 For each element in the alist, car is the package name and the cdr is
120 a plist containing information about the package. Typical fields 120 a plist containing information about the package. Typical fields
121 kept in the plist are: 121 kept in the plist are:
286 (mapcar (lambda (site) 286 (mapcar (lambda (site)
287 (vector (car site) 287 (vector (car site)
288 `(if (member (quote ,(cdr site)) 288 `(if (member (quote ,(cdr site))
289 package-get-remote) 289 package-get-remote)
290 (setq package-get-remote 290 (setq package-get-remote
291 (delete (quote ,(cdr site)) package-get-remote)) 291 (delete (quote ,(cdr site))
292 package-get-remote))
292 (package-ui-add-site (quote ,(cdr site)))) 293 (package-ui-add-site (quote ,(cdr site))))
293 :style 'toggle 294 :style 'toggle
294 :selected `(member (quote ,(cdr site)) 295 :selected `(member (quote ,(cdr site))
295 package-get-remote))) 296 package-get-remote)))
296 package-get-download-sites)) 297 package-get-download-sites))
371 (md5 (current-buffer))))) 372 (md5 (current-buffer)))))
372 (unless (and location (file-writable-p location)) 373 (unless (and location (file-writable-p location))
373 (setq location package-get-user-index-filename)) 374 (setq location package-get-user-index-filename))
374 (when (y-or-n-p (concat "Update package index in " location "? ")) 375 (when (y-or-n-p (concat "Update package index in " location "? "))
375 (write-file location)))))) 376 (write-file location))))))
376 377
377 378
378 ;;;###autoload 379 ;;;###autoload
379 (defun package-get-update-base (&optional db-file force-current) 380 (defun package-get-update-base (&optional db-file force-current)
380 "Update the package-get database file with entries from DB-FILE. 381 "Update the package-get database file with entries from DB-FILE.
381 Unless FORCE-CURRENT is non-nil never try to update the database." 382 Unless FORCE-CURRENT is non-nil never try to update the database."
513 "Perform interactive querying for package and optional version. 514 "Perform interactive querying for package and optional version.
514 Query for a version if GET-VERSION is non-nil. Return package name as 515 Query for a version if GET-VERSION is non-nil. Return package name as
515 a symbol instead of a string if PACKAGE-SYMBOL is non-nil. 516 a symbol instead of a string if PACKAGE-SYMBOL is non-nil.
516 The return value is suitable for direct passing to `interactive'." 517 The return value is suitable for direct passing to `interactive'."
517 (package-get-require-base t) 518 (package-get-require-base t)
518 (let ( (table (mapcar '(lambda (item) 519 (let ((table (mapcar #'(lambda (item)
519 (let ( (name (symbol-name (car item))) ) 520 (let ((name (symbol-name (car item))))
520 (cons name name) 521 (cons name name)))
521 )) 522 package-get-base))
522 package-get-base)) 523 package package-symbol default-version version)
523 package package-symbol default-version version)
524 (save-window-excursion 524 (save-window-excursion
525 (setq package (completing-read "Package: " table nil t)) 525 (setq package (completing-read "Package: " table nil t))
526 (setq package-symbol (intern package)) 526 (setq package-symbol (intern package))
527 (if get-version 527 (if get-version
528 (progn 528 (progn
529 (setq default-version 529 (setq default-version
530 (package-get-info-prop 530 (package-get-info-prop
531 (package-get-info-version 531 (package-get-info-version
532 (package-get-info-find-package package-get-base 532 (package-get-info-find-package package-get-base
533 package-symbol) nil) 533 package-symbol) nil)
534 'version)) 534 'version))
535 (while (string= 535 (while (string=
540 (list package-symbol version) 540 (list package-symbol version)
541 (list package version)) 541 (list package version))
542 ) 542 )
543 (if package-symbol 543 (if package-symbol
544 (list package-symbol) 544 (list package-symbol)
545 (list package))) 545 (list package))))))
546 )))
547 546
548 ;;;###autoload 547 ;;;###autoload
549 (defun package-get-delete-package (package &optional pkg-topdir) 548 (defun package-get-delete-package (package &optional pkg-topdir)
550 "Delete an installation of PACKAGE below directory PKG-TOPDIR. 549 "Delete an installation of PACKAGE below directory PKG-TOPDIR.
551 PACKAGE is a symbol, not a string. 550 PACKAGE is a symbol, not a string.
704 'always always retrieve the package even if it is already installed 703 'always always retrieve the package even if it is already installed
705 'never do not retrieve the package if it is installed. 704 'never do not retrieve the package if it is installed.
706 INSTALL-DIR, if non-nil, specifies the package directory where 705 INSTALL-DIR, if non-nil, specifies the package directory where
707 fetched packages should be installed. 706 fetched packages should be installed.
708 707
709 The value of `package-get-base' is used to determine what files should 708 The value of `package-get-base' is used to determine what files should
710 be retrieved. The value of `package-get-remote' is used to determine 709 be retrieved. The value of `package-get-remote' is used to determine
711 where a package should be retrieved from. The sites are tried in 710 where a package should be retrieved from. The sites are tried in
712 order so one is better off listing easily reached sites first. 711 order so one is better off listing easily reached sites first.
713 712
714 Once the package is retrieved, its md5 checksum is computed. If that 713 Once the package is retrieved, its md5 checksum is computed. If that
812 ;; If the file exists on the remote system ... 811 ;; If the file exists on the remote system ...
813 ( (file-exists-p (package-get-remote-filename 812 ( (file-exists-p (package-get-remote-filename
814 current-dir-entry current-filename)) 813 current-dir-entry current-filename))
815 ;; Get it 814 ;; Get it
816 (setq full-package-filename dest-filename) 815 (setq full-package-filename dest-filename)
817 (message "Retrieving package `%s' ..." 816 (message "Retrieving package `%s' ..."
818 current-filename) 817 current-filename)
819 (sit-for 0) 818 (sit-for 0)
820 (copy-file (package-get-remote-filename current-dir-entry 819 (copy-file (package-get-remote-filename current-dir-entry
821 current-filename) 820 current-filename)
822 full-package-filename t) 821 full-package-filename t)
898 associated with it. See `package-get-base' for info on the format 897 associated with it. See `package-get-base' for info on the format
899 returned. 898 returned.
900 899
901 To access fields returned from this, use 900 To access fields returned from this, use
902 `package-get-info-version' to return information about particular a 901 `package-get-info-version' to return information about particular a
903 version. Use `package-get-info-find-prop' to find particular property 902 version. Use `package-get-info-find-prop' to find particular property
904 from a version returned by `package-get-info-version'." 903 from a version returned by `package-get-info-version'."
905 (interactive "xPackage list: \nsPackage Name: ") 904 (interactive "xPackage list: \nsPackage Name: ")
906 (if which 905 (if which
907 (if (eq (caar which) name) 906 (if (eq (caar which) name)
908 (cdar which) 907 (cdar which)
910 (package-get-info-find-package (cdr which) name))))) 909 (package-get-info-find-package (cdr which) name)))))
911 910
912 (defun package-get-info-version (package version) 911 (defun package-get-info-version (package version)
913 "In PACKAGE, return the plist associated with a particular VERSION of the 912 "In PACKAGE, return the plist associated with a particular VERSION of the
914 package. PACKAGE is typically as returned by 913 package. PACKAGE is typically as returned by
915 `package-get-info-find-package'. If VERSION is nil, then return the 914 `package-get-info-find-package'. If VERSION is nil, then return the
916 first (aka most recent) version. Use `package-get-info-find-prop' 915 first (aka most recent) version. Use `package-get-info-find-prop'
917 to retrieve a particular property from the value returned by this." 916 to retrieve a particular property from the value returned by this."
918 (interactive (package-get-interactive-package-query t t)) 917 (interactive (package-get-interactive-package-query t t))
919 (while (and version package (not (string= (plist-get (car package) 'version) version))) 918 (while (and version package (not (string= (plist-get (car package) 'version) version)))
920 (setq package (cdr package))) 919 (setq package (cdr package)))
987 filename)))) 986 filename))))
988 987
989 988
990 (defun package-get-installedp (package version) 989 (defun package-get-installedp (package version)
991 "Determine if PACKAGE with VERSION has already been installed. 990 "Determine if PACKAGE with VERSION has already been installed.
992 I'm not sure if I want to do this by searching directories or checking 991 I'm not sure if I want to do this by searching directories or checking
993 some built in variables. For now, use packages-package-list." 992 some built in variables. For now, use packages-package-list."
994 ;; Use packages-package-list which contains name and version 993 ;; Use packages-package-list which contains name and version
995 (equal (plist-get 994 (equal (plist-get
996 (package-get-info-find-package packages-package-list 995 (package-get-info-find-package packages-package-list
997 package) ':version) 996 package) ':version)
999 998
1000 ;;;###autoload 999 ;;;###autoload
1001 (defun package-get-package-provider (sym &optional force-current) 1000 (defun package-get-package-provider (sym &optional force-current)
1002 "Search for a package that provides SYM and return the name and 1001 "Search for a package that provides SYM and return the name and
1003 version. Searches in `package-get-base' for SYM. If SYM is a 1002 version. Searches in `package-get-base' for SYM. If SYM is a
1004 consp, then it must match a corresponding (provide (SYM VERSION)) from 1003 consp, then it must match a corresponding (provide (SYM VERSION)) from
1005 the package. 1004 the package.
1006 1005
1007 If FORCE-CURRENT is non-nil make sure the database is up to date. This might 1006 If FORCE-CURRENT is non-nil make sure the database is up to date. This might
1008 lead to Emacs accessing remote sites." 1007 lead to Emacs accessing remote sites."
1009 (interactive "SSymbol: ") 1008 (interactive "SSymbol: ")
1052 t) 1051 t)
1053 package-get-base)) 1052 package-get-base))
1054 1053
1055 (defun package-get-ever-installed-p (pkg &optional notused) 1054 (defun package-get-ever-installed-p (pkg &optional notused)
1056 (string-match "-package$" (symbol-name pkg)) 1055 (string-match "-package$" (symbol-name pkg))
1057 (custom-initialize-set 1056 (custom-initialize-set
1058 pkg 1057 pkg
1059 (if (package-get-info-find-package 1058 (if (package-get-info-find-package
1060 packages-package-list 1059 packages-package-list
1061 (intern (substring (symbol-name pkg) 0 (match-beginning 0)))) 1060 (intern (substring (symbol-name pkg) 0 (match-beginning 0))))
1062 t))) 1061 t)))
1063 1062
1064 (defvar package-get-custom-groups nil 1063 (defvar package-get-custom-groups nil
1065 "List of package-get-custom groups") 1064 "List of package-get-custom groups")