Mercurial > hg > xemacs-beta
comparison lisp/package-get.el @ 286:57709be46d1b r21-0b41
Import from CVS: tag r21-0b41
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:35:03 +0200 |
parents | 558f606b08ae |
children | e11d67e05968 |
comparison
equal
deleted
inserted
replaced
285:9a3756523c1b | 286:57709be46d1b |
---|---|
94 | 94 |
95 ;;; Change Log | 95 ;;; Change Log |
96 | 96 |
97 ;;; Code: | 97 ;;; Code: |
98 | 98 |
99 (provide 'package-get) | |
100 (require 'package-admin) | 99 (require 'package-admin) |
101 | 100 |
102 (defvar package-get-base nil | 101 (defvar package-get-base nil |
103 "List of packages that are installed at this site. | 102 "List of packages that are installed at this site. |
104 For each element in the alist, car is the package name and the cdr is | 103 For each element in the alist, car is the package name and the cdr is |
165 "Fetch and install the latest versions of all currently installed packages." | 164 "Fetch and install the latest versions of all currently installed packages." |
166 (interactive) | 165 (interactive) |
167 ;; Load a fresh copy | 166 ;; Load a fresh copy |
168 (load "package-get-base.el") | 167 (load "package-get-base.el") |
169 (mapcar (lambda (pkg) | 168 (mapcar (lambda (pkg) |
170 (package-get-all | 169 (package-get-all |
171 (car pkg) nil)) | 170 (car pkg) nil)) |
172 packages-package-list)) | 171 packages-package-list)) |
173 | 172 |
174 (defun package-get-all (package version &optional fetched-packages) | 173 (defun package-get-all (package version &optional fetched-packages) |
175 "Fetch PACKAGE with VERSION and all other required packages. | 174 "Fetch PACKAGE with VERSION and all other required packages. |
176 Uses `package-get-base' to determine just what is required and what | 175 Uses `package-get-base' to determine just what is required and what |
400 (package-get-info-prop (car this-package) 'version)))) | 399 (package-get-info-prop (car this-package) 'version)))) |
401 (setq this-package (cdr this-package))))) | 400 (setq this-package (cdr this-package))))) |
402 (setq packages (cdr packages))) | 401 (setq packages (cdr packages))) |
403 found)) | 402 found)) |
404 | 403 |
404 ;; | |
405 ;; customize interfaces. | |
406 ;; The group is in this file so that custom loads includes this file. | |
407 ;; | |
408 (defgroup packages nil | |
409 "Configure XEmacs packages." | |
410 :group 'emacs) | |
411 | |
412 (defun package-get-custom () | |
413 "Fetch and install the latest versions of all customized packages." | |
414 (interactive) | |
415 ;; Load a fresh copy | |
416 (load "package-get-base.el") | |
417 (load "package-get-custom.el") | |
418 (mapcar (lambda (pkg) | |
419 (if (eval (intern (concat (symbol-name (car pkg)) "-package"))) | |
420 (package-get-all (car pkg) nil)) | |
421 t) | |
422 package-get-base)) | |
423 | |
424 (defun package-get-ever-installedp (pkg &optional notused) | |
425 (string-match "-package$" (symbol-name pkg)) | |
426 (custom-initialize-set | |
427 pkg | |
428 (if (package-get-info-find-package | |
429 packages-package-list | |
430 (intern (substring (symbol-name pkg) 0 (match-beginning 0)))) | |
431 t))) | |
432 | |
433 (defun package-get-create-custom () | |
434 "Creates a package customization file package-get-custom.el. | |
435 Entries in the customization file are retrieved from package-get-base.el." | |
436 (interactive) | |
437 ;; Load a fresh copy | |
438 (load "package-get-base.el") | |
439 (let ((custom-buffer (find-file-noselect | |
440 (or (file-installed-p "package-get-custom.el") | |
441 (concat (file-name-directory | |
442 (file-installed-p "package-get-base.el")) | |
443 "package-get-custom.el")))) | |
444 (pkg-groups nil)) | |
445 | |
446 ;; clear existing stuff | |
447 (delete-region (point-min custom-buffer) | |
448 (point-max custom-buffer) custom-buffer) | |
449 (insert-string "(require 'package-get)\n" custom-buffer) | |
450 | |
451 (mapcar (lambda (pkg) | |
452 (let ((category (plist-get (car (cdr pkg)) 'category))) | |
453 (or (memq (intern category) pkg-groups) | |
454 (progn | |
455 (setq pkg-groups (cons (intern category) pkg-groups)) | |
456 (insert-string | |
457 (concat "(defgroup " category "-packages nil\n" | |
458 " \"" category " package group\"\n" | |
459 " :group 'packages)\n\n") custom-buffer))) | |
460 | |
461 (insert-string | |
462 (concat "(defcustom " (symbol-name (car pkg)) | |
463 "-package nil \n" | |
464 " \"" (plist-get (car (cdr pkg)) 'description) "\"\n" | |
465 " :group '" category "-packages\n" | |
466 " :initialize 'package-get-ever-installedp\n" | |
467 " :type 'boolean)\n\n") custom-buffer))) | |
468 package-get-base) custom-buffer) | |
469 ) | |
470 | |
471 ;; need this first to avoid infinite dependency loops | |
472 (provide 'package-get) | |
473 | |
474 ;; potentially update the custom dependencies every time we load this | |
475 (let ((custom-file (file-installed-p "package-get-custom.el")) | |
476 (package-file (file-installed-p "package-get-base.el"))) | |
477 ;; update custom file if it doesn't exist | |
478 (if (or (not custom-file) | |
479 (and (< (car (nth 5 (file-attributes custom-file))) | |
480 (car (nth 5 (file-attributes package-file)))) | |
481 (< (car (nth 5 (file-attributes custom-file))) | |
482 (car (nth 5 (file-attributes package-file)))))) | |
483 (save-excursion | |
484 (message "generating package customizations...") | |
485 (set-buffer (package-get-create-custom)) | |
486 (save-buffer) | |
487 (message "generating package customizations...done"))) | |
488 (load "package-get-custom.el")) | |
489 | |
405 ;;; package-get.el ends here | 490 ;;; package-get.el ends here |