655 lines
24 KiB
EmacsLisp
655 lines
24 KiB
EmacsLisp
;;; quelpa.el --- Emacs Lisp packages built directly from source
|
|
|
|
;; Copyright 2014-2015, Steckerhalter
|
|
;; Copyright 2014-2015, Vasilij Schneidermann <v.schneidermann@gmail.com>
|
|
|
|
;; Author: steckerhalter
|
|
;; URL: https://github.com/quelpa/quelpa
|
|
;; Version: 0.0.1
|
|
;; Package-Requires: ((package-build "0") (emacs "24.3"))
|
|
;; Keywords: package management build source elpa
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
;; any later version.
|
|
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Your personal local Emacs Lisp Package Archive (ELPA) with packages
|
|
;; built on-the-fly directly from source.
|
|
|
|
;; See the README for more info:
|
|
;; https://github.com/quelpa/quelpa/blob/master/README.md
|
|
|
|
;;; Requirements:
|
|
|
|
;; Emacs 24.3.1
|
|
|
|
;;; Code:
|
|
|
|
(require 'package-build)
|
|
(require 'cl-lib)
|
|
(require 'help-fns)
|
|
(require 'url-parse)
|
|
|
|
;; --- customs / variables ---------------------------------------------------
|
|
|
|
(defgroup quelpa nil
|
|
"Build and install packages from source code"
|
|
:group 'package)
|
|
|
|
(defcustom quelpa-upgrade-p nil
|
|
"When non-nil, `quelpa' will try to upgrade packages.
|
|
The global value can be overridden for each package by supplying
|
|
the `:upgrade' argument."
|
|
:group 'quelpa
|
|
:type 'boolean)
|
|
|
|
(defcustom quelpa-stable-p nil
|
|
"When non-nil, try to build stable packages like MELPA does."
|
|
:group 'quelpa
|
|
:type 'boolean)
|
|
|
|
(defcustom quelpa-verbose t
|
|
"When non-nil, `quelpa' prints log messages."
|
|
:group 'quelpa
|
|
:type 'boolean)
|
|
|
|
(defcustom quelpa-before-hook nil
|
|
"List of functions to be called before quelpa."
|
|
:group 'quelpa
|
|
:type 'hook)
|
|
|
|
(defcustom quelpa-after-hook nil
|
|
"List of functions to be called after quelpa."
|
|
:group 'quelpa
|
|
:type 'hook)
|
|
|
|
(defcustom quelpa-dir (expand-file-name "quelpa" user-emacs-directory)
|
|
"Where quelpa builds and stores packages."
|
|
:group 'quelpa
|
|
:type 'string)
|
|
|
|
(defcustom quelpa-melpa-dir (expand-file-name "melpa" quelpa-dir)
|
|
"Where the melpa repo cloned to."
|
|
:group 'quelpa
|
|
:type 'string)
|
|
|
|
(defcustom quelpa-build-dir (expand-file-name "build" quelpa-dir)
|
|
"Where quelpa builds packages."
|
|
:group 'quelpa
|
|
:type 'string)
|
|
|
|
(defcustom quelpa-packages-dir (expand-file-name "packages" quelpa-dir)
|
|
"Where quelpa puts built packages."
|
|
:group 'quelpa
|
|
:type 'string)
|
|
|
|
(defcustom quelpa-melpa-recipe-stores (list (expand-file-name
|
|
"recipes"
|
|
quelpa-melpa-dir))
|
|
"Recipe stores where quelpa finds default recipes for packages.
|
|
A store can either be a string pointing to a directory with
|
|
recipe files or a list with recipes."
|
|
:group 'quelpa
|
|
:type '(repeat
|
|
(choice directory
|
|
(repeat
|
|
:tag "List of recipes"
|
|
(restricted-sexp :tag "Recipe"
|
|
:match-alternatives (listp))))))
|
|
|
|
(defcustom quelpa-persistent-cache-file (expand-file-name "cache" quelpa-dir)
|
|
"Location of the persistent cache file."
|
|
:group 'quelpa
|
|
:type 'string)
|
|
|
|
(defcustom quelpa-persistent-cache-p t
|
|
"Non-nil when quelpa's cache is saved on and read from disk."
|
|
:group 'quelpa
|
|
:type 'boolean)
|
|
|
|
(defcustom quelpa-checkout-melpa-p t
|
|
"If non-nil the MELPA git repo is cloned when quelpa is initialized."
|
|
:group 'quelpa
|
|
:type 'boolean)
|
|
|
|
(defcustom quelpa-update-melpa-p t
|
|
"If non-nil the MELPA git repo is updated when quelpa is initialized.
|
|
If nil the update is disabled and the repo is only updated on
|
|
`quelpa-upgrade' or `quelpa-self-upgrade'."
|
|
:group 'quelpa
|
|
:type 'boolean)
|
|
|
|
(defcustom quelpa-melpa-repo-url "https://github.com/melpa/melpa.git"
|
|
"The melpa git repository url."
|
|
:group 'quelpa
|
|
:type 'string)
|
|
|
|
(defvar quelpa-initialized-p nil
|
|
"Non-nil when quelpa has been initialized.")
|
|
|
|
(defvar quelpa-cache nil
|
|
"The `quelpa' command stores processed pkgs/recipes in the cache.")
|
|
|
|
(defvar quelpa-recipe '(quelpa :repo "quelpa/quelpa" :fetcher github)
|
|
"The recipe for quelpa.")
|
|
|
|
;; --- compatibility for legacy `package.el' in Emacs 24.3 -------------------
|
|
|
|
(defun quelpa-setup-package-structs ()
|
|
"Setup the struct `package-desc' when not available.
|
|
`package-desc-from-legacy' is provided to convert the legacy
|
|
vector desc into a valid PACKAGE-DESC."
|
|
(unless (functionp 'package-desc-p)
|
|
(cl-defstruct
|
|
(package-desc
|
|
(:constructor
|
|
;; convert legacy package desc into PACKAGE-DESC
|
|
package-desc-from-legacy
|
|
(pkg-info kind
|
|
&aux
|
|
(name (intern (aref pkg-info 0)))
|
|
(version (version-to-list (aref pkg-info 3)))
|
|
(summary (if (string= (aref pkg-info 2) "")
|
|
"No description available."
|
|
(aref pkg-info 2)))
|
|
(reqs (aref pkg-info 1))
|
|
(kind kind))))
|
|
name
|
|
version
|
|
(summary "No description available.")
|
|
reqs
|
|
kind
|
|
archive
|
|
dir
|
|
extras
|
|
signed)))
|
|
|
|
;; --- package building ------------------------------------------------------
|
|
|
|
(defun quelpa-package-type (file)
|
|
"Determine the package type of FILE.
|
|
Return `tar' for tarball packages, `single' for single file
|
|
packages, or nil, if FILE is not a package."
|
|
(let ((ext (file-name-extension file)))
|
|
(cond
|
|
((string= ext "tar") 'tar)
|
|
((string= ext "el") 'single)
|
|
(:else nil))))
|
|
|
|
(defun quelpa-get-package-desc (file)
|
|
"Extract and return the PACKAGE-DESC struct from FILE.
|
|
On error return nil."
|
|
(let* ((kind (quelpa-package-type file))
|
|
(desc (with-demoted-errors "Error getting PACKAGE-DESC: %s"
|
|
(with-temp-buffer
|
|
(pcase kind
|
|
(`single (insert-file-contents file)
|
|
(package-buffer-info))
|
|
(`tar (insert-file-contents-literally file)
|
|
(tar-mode)
|
|
(if (help-function-arglist 'package-tar-file-info)
|
|
;; legacy `package-tar-file-info' requires an arg
|
|
(package-tar-file-info file)
|
|
(with-no-warnings (package-tar-file-info)))))))))
|
|
(pcase desc
|
|
((pred package-desc-p) desc)
|
|
((pred vectorp) (package-desc-from-legacy desc kind)))))
|
|
|
|
(defun quelpa-archive-file-name (archive-entry)
|
|
"Return the path of the file in which the package for ARCHIVE-ENTRY is stored."
|
|
(let* ((name (car archive-entry))
|
|
(pkg-info (cdr archive-entry))
|
|
(version (package-version-join (aref pkg-info 0)))
|
|
(flavour (aref pkg-info 3)))
|
|
(expand-file-name
|
|
(format "%s-%s.%s" name version (if (eq flavour 'single) "el" "tar"))
|
|
quelpa-packages-dir)))
|
|
|
|
(defun quelpa-version>-p (name version)
|
|
"Return non-nil if VERSION of pkg with NAME is newer than what is currently installed."
|
|
(not (or (not version)
|
|
(let ((pkg-desc (cdr (assq name package-alist))))
|
|
(and pkg-desc
|
|
(version-list-<=
|
|
(version-to-list version)
|
|
(if (functionp 'package-desc-vers)
|
|
(package-desc-vers pkg-desc) ;old implementation
|
|
(package-desc-version (car pkg-desc))))))
|
|
;; Also check built-in packages.
|
|
(package-built-in-p name (version-to-list version)))))
|
|
|
|
(defun quelpa-checkout (rcp dir)
|
|
"Return the version of the new package given a RCP.
|
|
Return nil if the package is already installed and should not be upgraded."
|
|
(pcase-let ((`(,name . ,config) rcp)
|
|
(package-build-stable quelpa-stable-p))
|
|
(unless (or (and (assq name package-alist) (not quelpa-upgrade-p))
|
|
(and (not config)
|
|
(quelpa-message t "no recipe found for package `%s'" name)))
|
|
(let ((version (condition-case err
|
|
(package-build-checkout name config dir)
|
|
(error (quelpa-message t
|
|
"failed to checkout `%s': `%s'"
|
|
name
|
|
(error-message-string err))
|
|
nil))))
|
|
(when (quelpa-version>-p name version)
|
|
version)))))
|
|
|
|
(defun quelpa-build-package (rcp)
|
|
"Build a package from the given recipe RCP.
|
|
Uses the `package-build' library to get the source code and build
|
|
an elpa compatible package in `quelpa-build-dir' storing it in
|
|
`quelpa-packages-dir'. Return the path to the created file or nil
|
|
if no action is necessary (like when the package is installed
|
|
already and should not be upgraded etc)."
|
|
(let* ((name (car rcp))
|
|
(build-dir (expand-file-name (symbol-name name) quelpa-build-dir))
|
|
(version (quelpa-checkout rcp build-dir)))
|
|
(when version
|
|
(quelpa-archive-file-name
|
|
(package-build-package (symbol-name name)
|
|
version
|
|
(package-build--config-file-list (cdr rcp))
|
|
build-dir
|
|
quelpa-packages-dir)))))
|
|
|
|
;; --- package-build.el integration ------------------------------------------
|
|
|
|
(defun quelpa-file-version (file-path type version time-stamp)
|
|
"Return version of file at FILE-PATH."
|
|
(if (eq type 'directory)
|
|
time-stamp
|
|
(cl-letf* ((package-strip-rcs-id-orig (symbol-function 'package-strip-rcs-id))
|
|
((symbol-function 'package-strip-rcs-id)
|
|
(lambda (str)
|
|
(or (funcall package-strip-rcs-id-orig (lm-header "package-version"))
|
|
(funcall package-strip-rcs-id-orig (lm-header "version"))
|
|
"0"))))
|
|
(concat (mapconcat
|
|
#'number-to-string
|
|
(package-desc-version (quelpa-get-package-desc file-path)) ".")
|
|
(pcase version
|
|
(`original "")
|
|
(_ (concat "pre0." time-stamp)))))))
|
|
|
|
(defun quelpa-directory-files (path)
|
|
"Return list of directory files from PATH recursively."
|
|
(let ((result '()))
|
|
(mapc
|
|
(lambda (file)
|
|
(if (file-directory-p file)
|
|
(progn
|
|
;; When directory is not empty.
|
|
(when (cddr (directory-files file))
|
|
(dolist (subfile (quelpa-directory-files file))
|
|
(add-to-list 'result subfile))))
|
|
(add-to-list 'result file)))
|
|
(mapcar
|
|
(lambda (file) (expand-file-name file path))
|
|
;; Without first two entries because they are always "." and "..".
|
|
(cddr (directory-files path))))
|
|
result))
|
|
|
|
(defun quelpa-expand-source-file-list (file-path config)
|
|
"Return list of source files from FILE-PATH corresponding to
|
|
CONFIG."
|
|
(let ((source-files
|
|
(mapcar
|
|
(lambda (file) (expand-file-name file file-path))
|
|
(package-build--expand-source-file-list file-path config))))
|
|
;; Replace any directories in the source file list with the filenames of the
|
|
;; files they contain (so that these files can subsequently be hashed).
|
|
(dolist (file source-files source-files)
|
|
(when (file-directory-p file)
|
|
(setq source-files (remove file source-files))
|
|
(setq source-files (append source-files
|
|
(quelpa-directory-files file)))))))
|
|
|
|
(defun quelpa-slurp-file (file)
|
|
"Return the contents of FILE as a string, or nil if no such
|
|
file exists."
|
|
(when (file-exists-p file)
|
|
(with-temp-buffer
|
|
(set-buffer-multibyte nil)
|
|
(setq-local buffer-file-coding-system 'binary)
|
|
(insert-file-contents-literally file)
|
|
(buffer-substring-no-properties (point-min) (point-max)))))
|
|
|
|
(defun quelpa-check-hash (name config file-path dir &optional fetcher)
|
|
"Check if hash of FILE-PATH is different as in STAMP-FILE.
|
|
If it is different save the new hash and timestamp to STAMP-FILE
|
|
and return TIME-STAMP, otherwise return OLD-TIME-STAMP."
|
|
(unless (file-directory-p dir)
|
|
(make-directory dir))
|
|
(let* (files
|
|
hashes
|
|
new-stamp-info
|
|
new-content-hash
|
|
(time-stamp
|
|
(replace-regexp-in-string "\\.0" "." (format-time-string "%Y%m%d.%H%M%S")))
|
|
(stamp-file (concat (expand-file-name (symbol-name name) dir) ".stamp"))
|
|
(old-stamp-info (package-build--read-from-file stamp-file))
|
|
(old-content-hash (cdr old-stamp-info))
|
|
(old-time-stamp (car old-stamp-info))
|
|
(type (if (file-directory-p file-path) 'directory 'file))
|
|
(version (plist-get config :version)))
|
|
|
|
(if (not (file-exists-p file-path))
|
|
(error (quelpa-message t "`%s' does not exist" file-path))
|
|
(if (eq type 'directory)
|
|
(setq files (quelpa-expand-source-file-list file-path config)
|
|
hashes (mapcar
|
|
(lambda (file)
|
|
(secure-hash
|
|
'sha1 (concat file (quelpa-slurp-file file)))) files)
|
|
new-content-hash (secure-hash 'sha1 (mapconcat 'identity hashes "")))
|
|
(setq new-content-hash (secure-hash 'sha1 (quelpa-slurp-file file-path)))))
|
|
|
|
(setq new-stamp-info (cons time-stamp new-content-hash))
|
|
(if (and old-content-hash
|
|
(string= new-content-hash old-content-hash))
|
|
(quelpa-file-version file-path type version old-time-stamp)
|
|
(unless (eq fetcher 'url)
|
|
(delete-directory dir t)
|
|
(make-directory dir)
|
|
(if (eq type 'file)
|
|
(copy-file file-path dir t t t t)
|
|
(copy-directory file-path dir t t t)))
|
|
(package-build--dump new-stamp-info stamp-file)
|
|
(quelpa-file-version file-path type version time-stamp))))
|
|
|
|
(defun package-build--checkout-file (name config dir)
|
|
"Build according to a PATH with config CONFIG into DIR as NAME.
|
|
Generic local file handler for package-build.el.
|
|
|
|
Handles the following cases:
|
|
|
|
local file:
|
|
|
|
Installs a single-file package from a local file. Use the :path
|
|
attribute with a PATH like \"/path/to/file.el\".
|
|
|
|
local directory:
|
|
|
|
Installs a multi-file package from a local directory. Use
|
|
the :path attribute with a PATH like \"/path/to/dir\"."
|
|
(quelpa-check-hash name config (expand-file-name (plist-get config :path)) dir))
|
|
|
|
(defun package-build--checkout-url (name config dir)
|
|
"Build according to an URL with config CONFIG into DIR as NAME.
|
|
Generic URL handler for package-build.el.
|
|
|
|
Handles the following cases:
|
|
|
|
local file:
|
|
|
|
Installs a single-file package from a local file. Use the :url
|
|
attribute with an URL like \"file:///path/to/file.el\".
|
|
|
|
remote file:
|
|
|
|
Installs a single-file package from a remote file. Use the :url
|
|
attribute with an URL like \"http://domain.tld/path/to/file.el\"."
|
|
(let* ((url (plist-get config :url))
|
|
(remote-file-name (file-name-nondirectory
|
|
(url-filename (url-generic-parse-url url))))
|
|
(local-path (expand-file-name remote-file-name dir))
|
|
(mm-attachment-file-modes (default-file-modes)))
|
|
(unless (string= (file-name-extension url) "el")
|
|
(error (quelpa-message t "<%s> does not end in .el" url)))
|
|
(unless (file-directory-p dir)
|
|
(make-directory dir))
|
|
(url-copy-file url local-path t)
|
|
(quelpa-check-hash name config local-path dir 'url)))
|
|
|
|
;; --- helpers ---------------------------------------------------------------
|
|
|
|
(defun quelpa-message (wait format-string &rest args)
|
|
"Log a message with FORMAT-STRING and ARGS when `quelpa-verbose' is non-nil.
|
|
If WAIT is nil don't wait after showing the message. If it is a
|
|
number, wait so many seconds. If WAIT is t wait the default time.
|
|
Return t in each case."
|
|
(when quelpa-verbose
|
|
(message "Quelpa: %s" (apply 'format format-string args))
|
|
(when (or (not noninteractive) wait) ; no wait if emacs is noninteractive
|
|
(sit-for (or (and (numberp wait) wait) 1.5) t)))
|
|
t)
|
|
|
|
(defun quelpa-read-cache ()
|
|
"Read from `quelpa-persistent-cache-file' in `quelpa-cache'."
|
|
(when (and quelpa-persistent-cache-p
|
|
(file-exists-p quelpa-persistent-cache-file))
|
|
(with-temp-buffer
|
|
(insert-file-contents-literally quelpa-persistent-cache-file)
|
|
(setq quelpa-cache
|
|
(read (buffer-substring-no-properties (point-min) (point-max)))))))
|
|
|
|
(defun quelpa-save-cache ()
|
|
"Write `quelpa-cache' to `quelpa-persistent-cache-file'."
|
|
(when quelpa-persistent-cache-p
|
|
(let (print-level print-length)
|
|
(with-temp-file quelpa-persistent-cache-file
|
|
(insert (prin1-to-string quelpa-cache))))))
|
|
|
|
(defun quelpa-update-cache (cache-item)
|
|
;; try removing existing recipes by name
|
|
(setq quelpa-cache (cl-remove (car cache-item)
|
|
quelpa-cache :key #'car))
|
|
(push cache-item quelpa-cache)
|
|
(setq quelpa-cache
|
|
(cl-sort quelpa-cache #'string<
|
|
:key (lambda (item) (symbol-name (car item))))))
|
|
|
|
(defun quelpa-parse-stable (cache-item)
|
|
;; in case :stable doesn't originate from PLIST, shadow the
|
|
;; default value anyways
|
|
(when (plist-member (cdr cache-item) :stable)
|
|
(setq quelpa-stable-p (plist-get (cdr cache-item) :stable)))
|
|
(when (and quelpa-stable-p (not (plist-get (cdr cache-item) :stable)))
|
|
(setf (cdr (last cache-item)) '(:stable t))))
|
|
|
|
(defun quelpa-checkout-melpa ()
|
|
"Fetch or update the melpa source code from Github.
|
|
If there is no error return non-nil.
|
|
If there is an error but melpa is already checked out return non-nil.
|
|
If there is an error and no existing checkout return nil."
|
|
(or (and (null quelpa-update-melpa-p)
|
|
(file-exists-p (expand-file-name ".git" quelpa-melpa-dir)))
|
|
(condition-case err
|
|
(package-build--checkout-git
|
|
'package-build
|
|
`(:url ,quelpa-melpa-repo-url :files ("*"))
|
|
quelpa-melpa-dir)
|
|
(error (quelpa-message t "failed to checkout melpa git repo: `%s'" (error-message-string err))
|
|
(file-exists-p (expand-file-name ".git" quelpa-melpa-dir))))))
|
|
|
|
(defun quelpa-get-melpa-recipe (name)
|
|
"Read recipe with NAME for melpa git checkout.
|
|
Return the recipe if it exists, otherwise nil."
|
|
(cl-loop for store in quelpa-melpa-recipe-stores
|
|
if (stringp store)
|
|
for file = (assoc-string name (directory-files store nil "^[^\.]+"))
|
|
when file
|
|
return (with-temp-buffer
|
|
(insert-file-contents-literally
|
|
(expand-file-name file store))
|
|
(read (buffer-string)))
|
|
else
|
|
for rcp = (assoc-string name store)
|
|
when rcp
|
|
return rcp))
|
|
|
|
(defun quelpa-setup-p ()
|
|
"Setup what we need for quelpa.
|
|
Return non-nil if quelpa has been initialized properly."
|
|
(catch 'quit
|
|
(dolist (dir (list quelpa-packages-dir quelpa-build-dir))
|
|
(unless (file-exists-p dir) (make-directory dir t)))
|
|
(unless quelpa-initialized-p
|
|
(quelpa-read-cache)
|
|
(quelpa-setup-package-structs)
|
|
(if quelpa-checkout-melpa-p
|
|
(unless (quelpa-checkout-melpa) (throw 'quit nil)))
|
|
(setq quelpa-initialized-p t))
|
|
t))
|
|
|
|
(defun quelpa-shutdown ()
|
|
"Do things that need to be done after running quelpa."
|
|
(quelpa-save-cache)
|
|
;; remove the packages dir because we are done with the built pkgs
|
|
(ignore-errors (delete-directory quelpa-packages-dir t)))
|
|
|
|
(defun quelpa-arg-rcp (arg)
|
|
"Given recipe or package name, return an alist '(NAME . RCP).
|
|
If RCP cannot be found it will be set to nil"
|
|
(pcase arg
|
|
(`(,a . nil) (quelpa-get-melpa-recipe (car arg)))
|
|
(`(,a . ,_) arg)
|
|
((pred symbolp) (quelpa-get-melpa-recipe arg))))
|
|
|
|
(defun quelpa-parse-plist (plist)
|
|
"Parse the optional PLIST argument of `quelpa'.
|
|
Recognized keywords are:
|
|
|
|
:upgrade
|
|
|
|
If t, `quelpa' tries to do an upgrade.
|
|
|
|
:stable
|
|
|
|
If t, `quelpa' tries building the stable version of a package."
|
|
(while plist
|
|
(let ((key (car plist))
|
|
(value (cadr plist)))
|
|
(pcase key
|
|
(:upgrade (setq quelpa-upgrade-p value))
|
|
(:stable (setq quelpa-stable-p value))))
|
|
(setq plist (cddr plist))))
|
|
|
|
(defun quelpa-package-install-file (file)
|
|
"Workaround problem with `package-install-file'.
|
|
`package-install-file' uses `insert-file-contents-literally'
|
|
which causes problems when the file inserted has crlf line
|
|
endings (Windows). So here we replace that with
|
|
`insert-file-contents' for non-tar files."
|
|
(if (eq system-type 'windows-nt)
|
|
(cl-letf* ((insert-file-contents-literally-orig
|
|
(symbol-function 'insert-file-contents-literally))
|
|
((symbol-function 'insert-file-contents-literally)
|
|
(lambda (file)
|
|
(if (string-match "\\.tar\\'" file)
|
|
(funcall insert-file-contents-literally-orig file)
|
|
(insert-file-contents file)))))
|
|
(package-install-file file))
|
|
(package-install-file file)))
|
|
|
|
(defun quelpa-package-install (arg)
|
|
"Build and install package from ARG (a recipe or package name).
|
|
If the package has dependencies recursively call this function to
|
|
install them."
|
|
(let* ((rcp (quelpa-arg-rcp arg))
|
|
(file (and rcp (quelpa-build-package rcp))))
|
|
(when file
|
|
(let* ((pkg-desc (quelpa-get-package-desc file))
|
|
(requires (package-desc-reqs pkg-desc)))
|
|
(when requires
|
|
(mapc (lambda (req)
|
|
(unless (equal 'emacs (car req))
|
|
(quelpa-package-install (car req))))
|
|
requires))
|
|
(quelpa-package-install-file file)))))
|
|
|
|
(defun quelpa-interactive-candidate ()
|
|
"Query the user for a recipe and return the name."
|
|
(when (quelpa-setup-p)
|
|
(let ((recipes (directory-files
|
|
(expand-file-name "recipes" quelpa-melpa-dir)
|
|
;; this regexp matches all files except dotfiles
|
|
nil "^[^.].+$")))
|
|
(intern (completing-read "Choose MELPA recipe: "
|
|
recipes nil t)))))
|
|
|
|
;; --- public interface ------------------------------------------------------
|
|
|
|
;;;###autoload
|
|
(defun quelpa-expand-recipe (recipe-name)
|
|
"Expand a given recipe name into full recipe.
|
|
If called interactively, let the user choose a recipe name and
|
|
insert the result into the current buffer."
|
|
(interactive (list (quelpa-interactive-candidate)))
|
|
(when (quelpa-setup-p)
|
|
(let* ((recipe (quelpa-get-melpa-recipe recipe-name)))
|
|
(when recipe
|
|
(if (called-interactively-p 'any)
|
|
(prin1 recipe (current-buffer)))
|
|
recipe))))
|
|
|
|
;;;###autoload
|
|
(defun quelpa-self-upgrade (&optional args)
|
|
"Upgrade quelpa itself.
|
|
ARGS are additional options for the quelpa recipe."
|
|
(interactive)
|
|
(when (quelpa-setup-p)
|
|
(quelpa (append quelpa-recipe args) :upgrade t)))
|
|
|
|
;;;###autoload
|
|
(defun quelpa-upgrade ()
|
|
"Upgrade all packages found in `quelpa-cache'.
|
|
This provides an easy way to upgrade all the packages for which
|
|
the `quelpa' command has been run in the current Emacs session."
|
|
(interactive)
|
|
(when (quelpa-setup-p)
|
|
(let ((quelpa-upgrade-p t))
|
|
(quelpa-self-upgrade)
|
|
(setq quelpa-cache
|
|
(cl-remove-if-not #'package-installed-p quelpa-cache :key #'car))
|
|
(mapc (lambda (item)
|
|
(when (package-installed-p (car (quelpa-arg-rcp item)))
|
|
(quelpa item)))
|
|
quelpa-cache))))
|
|
|
|
;;;###autoload
|
|
(defun quelpa (arg &rest plist)
|
|
"Build and install a package with quelpa.
|
|
ARG can be a package name (symbol) or a melpa recipe (list).
|
|
PLIST is a plist that may modify the build and/or fetch process.
|
|
If called interactively, `quelpa' will prompt for a MELPA package
|
|
to install.
|
|
|
|
When `quelpa' is called interactively with a prefix argument (e.g
|
|
C-u M-x quelpa) it will try to upgrade the given package even if
|
|
the global var `quelpa-upgrade-p' is set to nil."
|
|
|
|
(interactive (list (quelpa-interactive-candidate)))
|
|
(run-hooks 'quelpa-before-hook)
|
|
(when (quelpa-setup-p) ;if init fails we do nothing
|
|
(let* ((quelpa-upgrade-p (if current-prefix-arg t quelpa-upgrade-p)) ;shadow `quelpa-upgrade-p'
|
|
(quelpa-stable-p quelpa-stable-p) ;shadow `quelpa-stable-p'
|
|
(cache-item (if (symbolp arg) (list arg) arg)))
|
|
(quelpa-parse-plist plist)
|
|
(quelpa-parse-stable cache-item)
|
|
(quelpa-package-install arg)
|
|
(quelpa-update-cache cache-item)))
|
|
(quelpa-shutdown)
|
|
(run-hooks 'quelpa-after-hook))
|
|
|
|
(provide 'quelpa)
|
|
|
|
;;; quelpa.el ends here
|