Mercurial > hg > xemacs-beta
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") |