el-get/el-get-status.el

;;; el-get --- Manage the external elisp bits and pieces you depend upon
;;
;; Copyright (C) 2010-2011 Dimitri Fontaine
;;
;; Author: Dimitri Fontaine <dim@tapoueh.org>
;; URL: http://www.emacswiki.org/emacs/el-get
;; GIT: https://github.com/dimitri/el-get
;; Licence: WTFPL, grab your copy here: http://sam.zoy.org/wtfpl/
;;
;; This file is NOT part of GNU Emacs.
;;
;; Install
;;     Please see the README.asciidoc file from the same distribution

;;
;; package status --- a plist saved on a file, using symbols
;;
;; it should be possible to use strings instead, but in my tests it failed
;; miserably.
;;

(require 'cl)
(require 'pp)
(require 'el-get-core)

(defun el-get-package-name (package-symbol)
  "Returns a package name as a string."
  (cond ((keywordp package-symbol)
         (substring (symbol-name package-symbol) 1))
        ((symbolp package-symbol)
         (symbol-name package-symbol))
        ((stringp package-symbol)
         package-symbol)
        (t (error "Unknown package: %s"))))

(defun el-get-package-symbol (package)
  "Returns a package name as a non-keyword symbol"
  (cond ((keywordp package)
         (intern (substring (symbol-name package) 1)))
        ((symbolp package)
         package)
        ((stringp package) (intern package))
        (t (error "Unknown package: %s"))))

(defun el-get-package-keyword (package-name)
  "Returns a package name as a keyword :package."
  (if (keywordp package-name)
      package-name
    (intern (format ":%s" package-name))))

(defun el-get-save-package-status (package status &optional recipe)
  "Save given package status"
  (let* ((package (el-get-as-symbol package))
         (recipe
          (or recipe
              (when (string= status "installed")
                (el-get-package-def package)))
         (package-status-alist
          (assq-delete-all package (el-get-read-status-file)))
         (new-package-status-alist
          (sort (append package-status-alist
                        (list            ; alist of (PACKAGE . PROPERTIES-LIST)
                         (cons package (list 'status status 'recipe recipe))))
                (lambda (p1 p2)
                  (string< (el-get-as-string (car p1))
                           (el-get-as-string (car p2))))))
         print-level print-length)
    (with-temp-file el-get-status-file
      (insert (el-get-print-to-string new-package-status-alist 'pretty)))
    ;; Return the new alist
    new-package-status-alist))

(defun el-get-read-status-file ()
  "read `el-get-status-file' and return an alist of plist like:
   (PACKAGE . (status \"status\" recipe (:name ...)))"
  (let ((ps
         (when (file-exists-p el-get-status-file)
           (car (with-temp-buffer
                  (insert-file-contents-literally el-get-status-file)
                  (read-from-string (buffer-string)))))))
    (if (consp (car ps))         ; check for an alist, new format
        ps
      ;; convert to the new format, fetching recipes as we go
      (loop for (p s) on ps by 'cddr
            for psym = (el-get-package-symbol p)
            when psym
            collect (cons psym
                          (list 'status s
                                'recipe (when (string= s "installed")
                                          (el-get-package-def psym))))))))

(defun el-get-package-status-alist (&optional package-status-alist)
  "return an alist of (PACKAGE . STATUS)"
  (loop for (p . prop) in (or package-status-alist
                              (el-get-read-status-file))
        collect (cons p (plist-get prop 'status))))

(defun el-get-package-status-recipes (&optional package-status-alist)
  "return the list of recipes stored in the status file"
  (loop for (p . prop) in (or package-status-alist
                              (el-get-read-status-file))
        when (string= (plist-get prop 'status) "installed")
        collect (plist-get prop 'recipe)))

(defun el-get-read-package-status (package &optional package-status-alist)
  "return current status for PACKAGE"
  (let ((p-alist (or package-status-alist (el-get-read-status-file))))
    (plist-get (cdr (assq (el-get-as-symbol package) p-alist)) 'status)))

(define-obsolete-function-alias 'el-get-package-status 'el-get-read-package-status)

(defun el-get-read-package-status-recipe (package &optional package-status-alist)
  "return current status recipe for PACKAGE"
  (let ((p-alist (or package-status-alist (el-get-read-status-file))))
    (plist-get (cdr (assq (el-get-as-symbol package) p-alist)) 'recipe)))

(defun el-get-filter-package-alist-with-status (package-status-alist &rest statuses)
  "Return package names that are currently in given status"
  (loop for (p . prop) in package-status-alist
        for s = (plist-get prop 'status)
	when (member s statuses)
        collect (el-get-as-string p)))

(defun el-get-list-package-names-with-status (&rest statuses)
  "Return package names that are currently in given status"
  (apply #'el-get-filter-package-alist-with-status
         (el-get-read-status-file)
         statuses))

(defun el-get-read-package-with-status (action &rest statuses)
  "Read a package name in given status"
  (completing-read (format "%s package: " action)
                   (apply 'el-get-list-package-names-with-status statuses)))

(defun el-get-count-package-with-status (&rest statuses)
  "Return how many packages are currently in given status"
  (length (apply #'el-get-list-package-names-with-status statuses)))

(defun el-get-count-packages-with-status (packages &rest statuses)
  "Return how many packages are currently in given status in PACKAGES"
  (length (intersection
           (mapcar #'el-get-as-symbol (apply #'el-get-list-package-names-with-status statuses))
           (mapcar #'el-get-as-symbol packages))))

(defun el-get-extra-packages (&rest packages)
  "Return installed or required packages that are not in given package list"
  (let ((packages
	 ;; &rest could contain both symbols and lists
	 (loop for p in packages
	       when (listp p) append (mapcar 'el-get-as-symbol p)
	       else collect (el-get-as-symbol p))))
    (when packages
      (loop for (p . prop) in (el-get-read-status-file)
            for s = (plist-get prop 'status)
            for x = (el-get-package-symbol p)
            unless (member x packages)
            unless (equal s "removed")
            collect (list x s)))))

(defmacro el-get-with-status-sources (&rest body)
  "Evaluate BODY with `el-get-sources' bound to recipes from status file."
  `(let ((el-get-sources (el-get-package-status-recipes)))
     (progn ,@body)))
(put 'el-get-with-status-recipes 'lisp-indent-function
     (get 'progn 'lisp-indent-function))

(defvar el-get-status-recipe-updatable-properties
  '(:load-path
    :info
    :load
    :features
    :library
    :before
    :after
    :lazy)
  "Whitelist of properties that may be updated in cached recipes.

If you any have these properties set on a package in your
`el-get-sources', then the values from `el-get-sources' can be
used to replace the cached values without reinstalling or
updating the package..")

(defun el-get-merge-updatable-properties (package-or-source
                                          &optional ignore-non-updatable)
  "Merge updatable properties from package source into status file.

This function takes either a package name or a full package
source. The named package must already be installed. If given a
package name, the source is retrieved from `el-get-sources'. The
given source is compared to the cached source for the same
package. If it differs only in updatable properties (see
`el-get-status-recipe-updatable-properties'), then the updated
values from the given source will be saved to the recipe in the
status file, overwriting the old values stored there.

If any non-updatable properties differ, then an error is raised,
unless the optional second argument is non-nil, in which case
only a message is issued and the non-updatable properties are
simply ignored."
  (interactive
   (list (el-get-read-package-with-status "Update recipe" "installed")))
  (let* ((source
          (if (listp package-or-source)
              (or package-or-source
                  (error "package-or-source cannot be nil"))
            ;; Not using `el-get-package-def' here, because we only
            ;; want what is listed in `el-get-sources', not what is in
            ;; the recipe file.
            (loop for src in el-get-sources
                  when (string= package-or-source (el-get-source-name src))
                  if (symbolp src) (list :name src)
                  else src)))
         (pkg (el-get-as-symbol (el-get-source-name source)))
         (cached-recipe (el-get-read-package-status-recipe pkg))
         ;; Subset of properties that cannot be updated without a
         ;; package update or reinstall. If this is non-nil, then we
         ;; will abort with an error message.
         (noupdate-plist
          (loop for (k v) on source by 'cddr
                unless (eq k :name)
                unless (memq k el-get-status-recipe-updatable-properties)
                ;; We only care about non-updatable properties if they
                ;; don't match the cached value
                unless (equal v (plist-get cached-recipe k))
                append (list k v)))
         ;; Subset of properties that are updatable. If this is nil,
         ;; then there's nothing to update.
         (update-plist
          (loop for (k v) on source by 'cddr
                when (memq k el-get-status-recipe-updatable-properties)
                append (list k v))))
    (unless (el-get-package-is-installed pkg)
      (error "Package %s is not installed. Cannot update recipe." pkg))
    (when noupdate-plist
      (funcall
       (if ignore-non-updatable
           'el-get-verbose-message
         'error)
       "Cannot update the following properties on package %s:\n%s\n(Maybe you should use `el-get-update' or `el-get-reinstall' instead?)"
       pkg (pp-to-string noupdate-plist)))
    (if update-plist
        (progn
          (el-get-verbose-message
           "Updating the following properties on package %s:\n%s"
           pkg (pp-to-string update-plist))
          (let ((updated-recipe (el-get-read-package-status-recipe pkg)))
            (loop for (k v) on update-plist by 'cddr
                  do (plist-put updated-recipe k v))
            (el-get-save-package-status pkg "installed" updated-recipe)))
      (el-get-verbose-message "No properties to update on package %s" pkg))))

(provide 'el-get-status)