2011-09-20 21:15:52 +08:00
|
|
|
|
;;; el-get-core.el --- 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
|
2013-04-01 20:46:34 +08:00
|
|
|
|
;; Please see the README.md file from the same distribution
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
;;
|
2015-11-18 00:15:14 +08:00
|
|
|
|
;; el-get-core provides basic el-get API, intended for developers of el-get
|
2011-09-20 21:15:52 +08:00
|
|
|
|
;; and its methods. See the methods directory for implementation of them.
|
|
|
|
|
;;
|
|
|
|
|
|
|
|
|
|
(require 'dired)
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(require 'cl-lib)
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(require 'simple) ; needed for `apply-partially'
|
|
|
|
|
(require 'bytecomp)
|
|
|
|
|
(require 'autoload)
|
|
|
|
|
|
2014-03-23 06:43:42 +08:00
|
|
|
|
(declare-function el-get-package-def "el-get-recipes" (package))
|
|
|
|
|
(declare-function el-get-installation-failed "el-get" (package signal-data))
|
|
|
|
|
|
2012-03-30 05:47:28 +08:00
|
|
|
|
(defun el-get-print-to-string (object &optional pretty)
|
|
|
|
|
"Return string representation of lisp object.
|
|
|
|
|
|
|
|
|
|
Unlike the Emacs builtin printing functions, this ignores
|
|
|
|
|
`print-level' and `print-length', ensuring that as much as
|
|
|
|
|
possible the returned string will be a complete representation of
|
|
|
|
|
the original object."
|
|
|
|
|
(let (print-level print-length)
|
|
|
|
|
(funcall (if pretty #'pp-to-string #'prin1-to-string)
|
|
|
|
|
object)))
|
|
|
|
|
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(defun el-get-verbose-message (format &rest arguments)
|
|
|
|
|
(when el-get-verbose (apply 'message format arguments)))
|
|
|
|
|
|
2014-04-05 05:58:35 +08:00
|
|
|
|
(defmacro el-get-with-errors-as-warnings (prefix &rest body)
|
|
|
|
|
(declare (indent 1) (debug t))
|
|
|
|
|
(let ((error-var (make-symbol "err")))
|
|
|
|
|
`(condition-case ,error-var
|
|
|
|
|
(progn ,@body)
|
|
|
|
|
((debug error)
|
|
|
|
|
(display-warning 'el-get
|
|
|
|
|
(concat ,prefix (error-message-string ,error-var))
|
|
|
|
|
:error)
|
|
|
|
|
nil))))
|
|
|
|
|
|
2013-10-15 16:11:32 +08:00
|
|
|
|
(defsubst el-get-plist-keys (plist)
|
|
|
|
|
"Return a list of all keys in PLIST.
|
|
|
|
|
|
|
|
|
|
Duplicates are removed."
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-remove-duplicates
|
|
|
|
|
(cl-loop for (k _) on plist by #'cddr
|
|
|
|
|
collect k)
|
2013-10-15 16:11:32 +08:00
|
|
|
|
:test #'eq))
|
|
|
|
|
|
|
|
|
|
(defsubst el-get-keyword-name (keyword)
|
|
|
|
|
"Return the name of KEYWORD.
|
|
|
|
|
|
|
|
|
|
This is equivalent to `symbol-name' but it only works on keywords
|
|
|
|
|
and it strips the leading colon.
|
|
|
|
|
|
|
|
|
|
This raises an error if KEYWORD is not a keyword."
|
|
|
|
|
(or (keywordp keyword)
|
|
|
|
|
(error "Not a keyword: %S" keyword))
|
|
|
|
|
(substring (symbol-name keyword) 1))
|
|
|
|
|
|
2011-09-23 03:48:11 +08:00
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; el-get-methods support, those are like backends.
|
|
|
|
|
;;
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(defvar el-get-methods nil
|
|
|
|
|
"Register methods that el-get can use to fetch and update a given package.
|
|
|
|
|
|
|
|
|
|
The methods list is a PLIST, each entry has a method name
|
|
|
|
|
property which value is another PLIST, which must contain values
|
2012-02-02 08:08:32 +08:00
|
|
|
|
for :install, :install-hook, :update, :remove, :remove-hook
|
|
|
|
|
and :checksum properties. Those should be the elisp functions to
|
|
|
|
|
call for doing the named package action in the given method.")
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
2012-02-02 08:10:25 +08:00
|
|
|
|
(defun el-get-method-defined-p (name)
|
|
|
|
|
"Returns t if NAME is a known el-get install method backend, nil otherwise."
|
|
|
|
|
(and (el-get-method name :install) t))
|
|
|
|
|
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-defun el-get-register-method (name &key install update remove
|
|
|
|
|
install-hook update-hook remove-hook
|
|
|
|
|
compute-checksum guess-website)
|
2011-09-20 21:15:52 +08:00
|
|
|
|
"Register the method for backend NAME, with given functions"
|
2012-02-29 09:58:28 +08:00
|
|
|
|
(let (method-def)
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-loop for required-arg in '(install update remove)
|
|
|
|
|
unless (symbol-value required-arg)
|
|
|
|
|
do (error "Missing required argument: :%s" required-arg)
|
|
|
|
|
do (setq method-def
|
|
|
|
|
(plist-put method-def
|
|
|
|
|
(intern (format ":%s" required-arg))
|
|
|
|
|
(symbol-value required-arg))))
|
|
|
|
|
(cl-loop for optional-arg in '(install-hook update-hook remove-hook
|
|
|
|
|
compute-checksum guess-website)
|
|
|
|
|
if (symbol-value optional-arg)
|
|
|
|
|
do (setq method-def
|
|
|
|
|
(plist-put method-def
|
|
|
|
|
(intern (format ":%s" optional-arg))
|
|
|
|
|
(symbol-value optional-arg))))
|
2012-02-29 09:58:28 +08:00
|
|
|
|
(setq el-get-methods (plist-put el-get-methods name method-def))))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
2012-02-03 04:10:31 +08:00
|
|
|
|
(put 'el-get-register-method 'lisp-indent-function
|
|
|
|
|
(get 'prog1 'lisp-indent-function))
|
|
|
|
|
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-defun el-get-register-derived-method (name derived-from-name
|
|
|
|
|
&rest keys &key &allow-other-keys)
|
2012-02-02 08:10:25 +08:00
|
|
|
|
"Register the method for backend NAME.
|
|
|
|
|
|
|
|
|
|
Defaults for all optional arguments are taken from
|
|
|
|
|
already-defined method DERIVED-FROM-NAME."
|
|
|
|
|
(unless (el-get-method-defined-p derived-from-name)
|
|
|
|
|
(error "Cannot derive new el-get method from unknown method %s" derived-from-name))
|
2012-02-03 11:32:43 +08:00
|
|
|
|
(apply #'el-get-register-method name (append keys (plist-get el-get-methods derived-from-name))))
|
2012-02-02 08:10:25 +08:00
|
|
|
|
|
2012-02-03 04:10:31 +08:00
|
|
|
|
(put 'el-get-register-derived-method 'lisp-indent-function
|
|
|
|
|
(get 'prog2 'lisp-indent-function))
|
|
|
|
|
|
2012-02-02 08:10:25 +08:00
|
|
|
|
(defun el-get-register-method-alias (name old-name)
|
|
|
|
|
"Register NAME as an alias for install method OLD-NAME."
|
|
|
|
|
(el-get-register-derived-method name old-name))
|
2011-09-23 17:32:40 +08:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; "Fuzzy" data structure handling
|
|
|
|
|
;;
|
|
|
|
|
;; In el-get-sources, single elements are often allowed instead of a
|
|
|
|
|
;; list, and strings and symbols are often interchangeable.
|
|
|
|
|
;; Presumably it's easier for users who don't use the customization
|
|
|
|
|
;; interface to write such structures as raw elisp.
|
|
|
|
|
;;
|
|
|
|
|
;;; "Fuzzy" data structure conversion utilities
|
2014-12-03 22:01:05 +08:00
|
|
|
|
(defun el-get-as-string (obj)
|
|
|
|
|
"Return OBJ as a string."
|
|
|
|
|
(cond
|
|
|
|
|
((stringp obj) obj)
|
|
|
|
|
((symbolp obj) (symbol-name obj))
|
|
|
|
|
((numberp obj) (number-to-string obj))
|
|
|
|
|
(t (error "Can't convert %S to string." obj))))
|
2011-09-23 17:32:40 +08:00
|
|
|
|
|
|
|
|
|
(defun el-get-as-symbol (string-or-symbol)
|
|
|
|
|
"If STRING-OR-SYMBOL is already a symbol, return it. Otherwise
|
|
|
|
|
convert it to a symbol and return that."
|
|
|
|
|
(if (symbolp string-or-symbol) string-or-symbol
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(intern string-or-symbol)))
|
2011-09-23 17:32:40 +08:00
|
|
|
|
|
|
|
|
|
(defun el-get-as-list (element-or-list)
|
|
|
|
|
"If ELEMENT-OR-LIST is already a list, return it. Otherwise
|
|
|
|
|
returning a list that contains it (and only it)."
|
|
|
|
|
(if (listp element-or-list) element-or-list
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(list element-or-list)))
|
2011-09-23 17:32:40 +08:00
|
|
|
|
|
2011-10-07 05:17:30 +08:00
|
|
|
|
(defun el-get-list-of-strings-p (obj)
|
|
|
|
|
(or (null obj)
|
|
|
|
|
(and (consp obj)
|
|
|
|
|
(stringp (car obj))
|
|
|
|
|
(el-get-list-of-strings-p (cdr obj)))))
|
|
|
|
|
|
2011-09-23 20:07:50 +08:00
|
|
|
|
(defun el-get-source-name (source)
|
|
|
|
|
"Return the package name (stringp) given an `el-get-sources'
|
|
|
|
|
entry."
|
2013-05-10 15:40:16 +08:00
|
|
|
|
(if (and source (listp source))
|
2012-03-11 02:17:38 +08:00
|
|
|
|
(format "%s" (or (plist-get source :name)
|
|
|
|
|
(error "Source does not have a :name property: %S" source)))
|
|
|
|
|
(symbol-name source)))
|
2011-09-23 20:07:50 +08:00
|
|
|
|
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; Common support bits
|
|
|
|
|
;;
|
2012-12-15 05:48:18 +08:00
|
|
|
|
(defun el-get-rmdir (package url post-remove-fun)
|
2012-01-02 22:10:58 +08:00
|
|
|
|
"Just rm -rf the package directory. If it is a symlink, delete it."
|
2012-12-03 22:45:21 +08:00
|
|
|
|
(let* ((edir (expand-file-name el-get-dir))
|
|
|
|
|
(pdir (expand-file-name "." (el-get-package-directory package))))
|
|
|
|
|
;; check that we're all set
|
2012-12-04 16:58:18 +08:00
|
|
|
|
(when (or (string= edir pdir) ; package is "", or such like
|
|
|
|
|
;; error if pdir is not a subdirectory of el-get-dir
|
|
|
|
|
(not (string= edir (substring pdir 0 (length edir)))))
|
2012-12-03 22:45:21 +08:00
|
|
|
|
(error "el-get-rmdir: directory '%s' of package '%s' is not inside `el-get-dir' ('%s')."
|
|
|
|
|
pdir package el-get-dir))
|
2012-01-02 22:10:58 +08:00
|
|
|
|
(cond ((file-symlink-p pdir)
|
|
|
|
|
(delete-file pdir))
|
|
|
|
|
((file-directory-p pdir)
|
|
|
|
|
(delete-directory pdir 'recursive))
|
|
|
|
|
((file-exists-p pdir)
|
2012-12-15 05:48:18 +08:00
|
|
|
|
(delete-file pdir)))
|
2013-07-19 21:37:50 +08:00
|
|
|
|
(when post-remove-fun
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(funcall post-remove-fun package))))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
2014-12-26 00:19:50 +08:00
|
|
|
|
(defconst el-get-no-shell-quote "\\`[-,./_[:alnum:]]+\\'"
|
|
|
|
|
"Regular expression matching arguments that don't shell quoting.")
|
|
|
|
|
|
2014-10-15 12:42:05 +08:00
|
|
|
|
(defun el-get-shell-quote-program (program-name)
|
|
|
|
|
"Like `shell-quote-argument' but needs special treatment on Windows."
|
2014-12-26 00:19:50 +08:00
|
|
|
|
(or (when (string-match-p el-get-no-shell-quote program-name) program-name)
|
|
|
|
|
(when (fboundp 'w32-short-file-name)
|
2014-12-23 11:12:02 +08:00
|
|
|
|
;; If program is really a bat file, putting double quotes around
|
|
|
|
|
;; it will lead to problems if subsequent arguments are also
|
|
|
|
|
;; quoted. Use the short 8.3 name instead of quoting. See
|
|
|
|
|
;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18745 for
|
|
|
|
|
;; details.
|
|
|
|
|
(let (exe (executable-find program-name))
|
|
|
|
|
(when exe (w32-short-file-name exe))))
|
|
|
|
|
(shell-quote-argument program-name)))
|
2014-10-15 12:42:05 +08:00
|
|
|
|
|
2014-12-26 00:19:50 +08:00
|
|
|
|
(defun el-get-maybe-shell-quote-argument (arg)
|
|
|
|
|
"`shell-quote-argument', if necessary."
|
|
|
|
|
(if (string-match-p el-get-no-shell-quote arg) arg
|
|
|
|
|
(shell-quote-argument arg)))
|
|
|
|
|
|
2015-07-08 23:59:02 +08:00
|
|
|
|
(defun el-get-read-from-file (filename)
|
|
|
|
|
"Read given FILENAME and return its content (a valid sexp is expected)."
|
|
|
|
|
(condition-case err
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(insert-file-contents filename)
|
|
|
|
|
(read (current-buffer)))
|
|
|
|
|
((debug error)
|
|
|
|
|
(error "Error reading file %s: %S" filename err))))
|
|
|
|
|
|
2015-11-14 10:59:06 +08:00
|
|
|
|
(defun el-get-package-is-installed (package)
|
|
|
|
|
"Return true if PACKAGE is installed"
|
|
|
|
|
(and (file-directory-p (el-get-package-directory package))
|
|
|
|
|
(string= "installed"
|
|
|
|
|
(el-get-read-package-status package))))
|
|
|
|
|
|
|
|
|
|
(defalias 'el-get-package-installed-p #'el-get-package-is-installed)
|
|
|
|
|
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; Some tools
|
|
|
|
|
;;
|
|
|
|
|
(defun el-get-duplicates (list)
|
|
|
|
|
"Return duplicates found in list."
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-loop with dups and once
|
|
|
|
|
for elt in list
|
|
|
|
|
if (member elt once) collect elt into dups
|
|
|
|
|
else collect elt into once
|
|
|
|
|
finally return dups))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
|
|
|
|
(defun el-get-flatten (arg)
|
|
|
|
|
"Return a version of ARG as a one-level list
|
|
|
|
|
|
|
|
|
|
(el-get-flatten 'x) => '(x)
|
|
|
|
|
(el-get-flatten '(a (b c (d)) e)) => '(a b c d e)"
|
|
|
|
|
(if (listp arg)
|
|
|
|
|
(apply 'append (mapcar 'el-get-flatten arg))
|
|
|
|
|
(list arg)))
|
|
|
|
|
|
2015-07-10 02:11:12 +08:00
|
|
|
|
(defun el-get-unquote (arg)
|
|
|
|
|
"Remote quote from ARG, if there is one."
|
|
|
|
|
(if (eq (car arg) 'quote) (nth 1 arg) arg))
|
|
|
|
|
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(defun el-get-load-path (package)
|
|
|
|
|
"Return the list of absolute directory names to be added to
|
|
|
|
|
`load-path' by the named PACKAGE."
|
|
|
|
|
(let* ((source (el-get-package-def package))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(el-path (if (plist-member source :load-path)
|
2012-03-04 06:41:36 +08:00
|
|
|
|
(el-get-flatten (plist-get source :load-path))
|
|
|
|
|
'(".")))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(pkg-dir (el-get-package-directory package)))
|
|
|
|
|
(mapcar (lambda (p) (expand-file-name p pkg-dir)) el-path)))
|
|
|
|
|
|
|
|
|
|
(defun el-get-method (method-name action)
|
|
|
|
|
"Return the function to call for doing action (e.g. install) in
|
|
|
|
|
given method."
|
2012-02-02 08:10:25 +08:00
|
|
|
|
(let* ((method (if (keywordp method-name) method-name
|
|
|
|
|
(intern (concat ":" (format "%s" method-name)))))
|
|
|
|
|
(actions (plist-get el-get-methods method)))
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-assert actions nil
|
|
|
|
|
"Unknown recipe type: %s" method)
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(plist-get actions action)))
|
|
|
|
|
|
|
|
|
|
(defun el-get-check-init ()
|
|
|
|
|
"Check that we can run el-get."
|
|
|
|
|
(unless (file-directory-p el-get-dir)
|
|
|
|
|
(make-directory el-get-dir)))
|
|
|
|
|
|
|
|
|
|
(defun el-get-package-directory (package)
|
|
|
|
|
"Return the absolute directory name of the named PACKAGE."
|
|
|
|
|
(file-name-as-directory
|
2011-09-23 03:48:11 +08:00
|
|
|
|
(expand-file-name (el-get-as-string package)
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(expand-file-name el-get-dir))))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
|
|
|
|
(defun el-get-add-path-to-list (package list path)
|
|
|
|
|
"(add-to-list LIST PATH) checking for path existence within
|
|
|
|
|
given package directory."
|
|
|
|
|
(let* ((pdir (el-get-package-directory package))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(fullpath (expand-file-name (or path ".") pdir)))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(unless (file-directory-p fullpath)
|
|
|
|
|
(error "el-get could not find directory `%s' for package %s, at %s"
|
2014-02-22 02:52:48 +08:00
|
|
|
|
path package fullpath))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(add-to-list list fullpath)))
|
|
|
|
|
|
|
|
|
|
(defun el-get-package-exists-p (package)
|
|
|
|
|
"Return true only when the given package name is either a
|
|
|
|
|
directory or a symlink in el-get-dir."
|
|
|
|
|
(let ((pdir (el-get-package-directory package)))
|
|
|
|
|
;; seems overkill as file-directory-p will always be true
|
|
|
|
|
(or (file-directory-p pdir)
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(file-symlink-p pdir))))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
2014-10-14 01:19:53 +08:00
|
|
|
|
(defun el-get-url-host (url)
|
|
|
|
|
"Extract host from given URL.
|
|
|
|
|
|
|
|
|
|
Earlier we used the built-in library `url-parse' to extract host. This broke
|
|
|
|
|
installation of CEDET since it requires that the built-in versions of certain
|
|
|
|
|
packages (one of them is `eieio') are not loaded before loading it. However
|
|
|
|
|
`url-parse' depends on `auth-source' which in turn depends on `eieio' leading to
|
|
|
|
|
loading of `eieio' before initializing CEDET causing CEDET's initialization to
|
|
|
|
|
fail."
|
|
|
|
|
(string-match "://\\([^/:]+\\)" url)
|
|
|
|
|
(match-string-no-properties 1 url))
|
|
|
|
|
|
2011-10-11 16:37:52 +08:00
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; el-get-reload API functions
|
|
|
|
|
;;
|
2014-11-23 22:23:50 +08:00
|
|
|
|
(defun el-get-package-files (pdir)
|
|
|
|
|
"Return a list of files loaded from directory PDIR."
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-loop with regexp = (format "^%s" (regexp-quote (file-name-as-directory (file-truename pdir))))
|
|
|
|
|
for (f . nil) in load-history
|
|
|
|
|
when (and (stringp f) (string-match-p regexp (file-truename f)))
|
|
|
|
|
collect (if (string-match-p "\\.elc?$" f)
|
|
|
|
|
(file-name-sans-extension f)
|
|
|
|
|
f)))
|
2011-10-11 16:37:52 +08:00
|
|
|
|
|
2014-11-23 22:23:50 +08:00
|
|
|
|
(defun el-get-package-features (pdir)
|
|
|
|
|
"Return a list of features provided by files in PDIR."
|
2021-01-30 20:17:05 +08:00
|
|
|
|
(cl-loop with regexp = (format "^%s" (regexp-quote (file-name-as-directory (expand-file-name pdir))))
|
|
|
|
|
for (f . l) in load-history
|
|
|
|
|
when (and (stringp f) (string-match-p regexp (file-truename f)))
|
|
|
|
|
nconc (cl-loop for i in l
|
|
|
|
|
when (and (consp i) (eq (car i) 'provide))
|
|
|
|
|
collect (cdr i))))
|
2011-10-11 04:04:10 +08:00
|
|
|
|
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; call-process-list utility
|
|
|
|
|
;;
|
|
|
|
|
(defun el-get-start-process-list-sentinel (proc change)
|
|
|
|
|
"When proc has exited and was successful, chain next command."
|
|
|
|
|
(when (eq (process-status proc) 'exit)
|
|
|
|
|
(condition-case err
|
|
|
|
|
(let ((status (process-exit-status proc))
|
|
|
|
|
(cname (process-get proc :command-name))
|
|
|
|
|
(cbuf (process-get proc :buffer-name))
|
|
|
|
|
(message (process-get proc :message))
|
|
|
|
|
(errorm (process-get proc :error))
|
|
|
|
|
(package (process-get proc :el-get-package))
|
|
|
|
|
(final-f (process-get proc :el-get-final-func))
|
|
|
|
|
(next (process-get proc :el-get-start-process-list))
|
|
|
|
|
(el-get-sources (process-get proc :el-get-sources)))
|
|
|
|
|
(if (not (eq 0 status))
|
|
|
|
|
(progn
|
|
|
|
|
(when (process-buffer proc)
|
|
|
|
|
(set-window-buffer (selected-window) cbuf))
|
|
|
|
|
(error "el-get: %s %s" cname errorm))
|
|
|
|
|
(message "el-get: %s" message))
|
|
|
|
|
|
|
|
|
|
(when cbuf (kill-buffer cbuf))
|
|
|
|
|
(if next
|
|
|
|
|
(el-get-start-process-list package next final-f)
|
|
|
|
|
(when (functionp final-f)
|
|
|
|
|
(funcall final-f package))))
|
|
|
|
|
((debug error)
|
|
|
|
|
(el-get-installation-failed (process-get proc :el-get-package) err)))))
|
|
|
|
|
|
|
|
|
|
(defvar el-get-default-process-sync nil
|
|
|
|
|
"Non-nil value asks `el-get-start-process-list' to run current
|
|
|
|
|
process synchronously. Can be overridden by :sync property in
|
|
|
|
|
commands argument of `el-get-start-process-list'")
|
|
|
|
|
|
|
|
|
|
(defun el-get-start-process-list (package commands final-func)
|
|
|
|
|
"Run each command one after the other, in order, stopping at
|
|
|
|
|
first error.
|
|
|
|
|
|
|
|
|
|
Commands should be a list of plists with at least the following
|
|
|
|
|
properties:
|
|
|
|
|
|
|
|
|
|
:default-directory
|
|
|
|
|
|
|
|
|
|
default-directory from where to start the command
|
|
|
|
|
|
|
|
|
|
:command-name
|
|
|
|
|
|
|
|
|
|
Name of the command to start, gives the name of the Emacs subprocess.
|
|
|
|
|
|
|
|
|
|
:buffer-name
|
|
|
|
|
|
|
|
|
|
Name of the buffer associated with the command.
|
|
|
|
|
|
|
|
|
|
:process-filter
|
|
|
|
|
|
|
|
|
|
Function to use as a process filter.
|
|
|
|
|
|
|
|
|
|
:shell
|
|
|
|
|
|
|
|
|
|
When set to a non-nil value, use start-process-shell-command
|
|
|
|
|
rather than the default start-process.
|
|
|
|
|
|
|
|
|
|
:program
|
|
|
|
|
|
|
|
|
|
The program to start
|
|
|
|
|
|
|
|
|
|
:args
|
|
|
|
|
|
|
|
|
|
The list of arguments for the program to start
|
|
|
|
|
|
|
|
|
|
:message
|
|
|
|
|
|
|
|
|
|
The message to send upon success
|
|
|
|
|
|
|
|
|
|
:error
|
|
|
|
|
|
|
|
|
|
The error to send upon failure
|
|
|
|
|
|
|
|
|
|
:sync
|
|
|
|
|
|
|
|
|
|
When set to non-nil value, run synchronously.
|
|
|
|
|
|
|
|
|
|
:stdin
|
|
|
|
|
|
|
|
|
|
Standard input to use for the process. A lisp value is
|
|
|
|
|
expected, it will get `prin1-to-string' then either saved to a
|
|
|
|
|
file for a synchronous process or sent with
|
|
|
|
|
`process-send-string' for an asynchronous one.
|
|
|
|
|
|
|
|
|
|
Any other property will get put into the process object.
|
2012-01-14 02:59:56 +08:00
|
|
|
|
|
|
|
|
|
Any element of commands that is nil will simply be ignored. This
|
|
|
|
|
makes it easier to conditionally splice a command into the list.
|
2011-09-20 21:15:52 +08:00
|
|
|
|
"
|
2012-01-14 02:59:56 +08:00
|
|
|
|
;; Skip nil elements of commands. This makes it easier for methods
|
|
|
|
|
;; to conditionally splice commands into the list.
|
|
|
|
|
(while (and commands (null (car commands)))
|
|
|
|
|
(setq commands (cdr commands)))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(condition-case err
|
|
|
|
|
(if commands
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(let* ((c (car commands))
|
|
|
|
|
(next (cdr commands))
|
|
|
|
|
(cdir (plist-get c :default-directory))
|
|
|
|
|
(cname (plist-get c :command-name))
|
|
|
|
|
(cbuf (plist-get c :buffer-name))
|
|
|
|
|
(killed (when (get-buffer cbuf) (kill-buffer cbuf)))
|
|
|
|
|
(filter (plist-get c :process-filter))
|
|
|
|
|
(shell (plist-get c :shell))
|
2013-05-03 05:56:58 +08:00
|
|
|
|
(program (if shell
|
2014-10-15 12:42:05 +08:00
|
|
|
|
(el-get-shell-quote-program (plist-get c :program))
|
2013-05-03 05:56:58 +08:00
|
|
|
|
(plist-get c :program)))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(args (if shell
|
2014-12-26 00:19:50 +08:00
|
|
|
|
(mapcar #'el-get-maybe-shell-quote-argument (plist-get c :args))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(plist-get c :args)))
|
|
|
|
|
(sync (el-get-plist-get-with-default c :sync
|
2014-03-02 08:19:46 +08:00
|
|
|
|
el-get-default-process-sync))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(stdin (plist-get c :stdin))
|
|
|
|
|
(default-directory (if cdir
|
|
|
|
|
(file-name-as-directory
|
|
|
|
|
(expand-file-name cdir))
|
|
|
|
|
default-directory)))
|
|
|
|
|
(unless program (error "el-get: :program argument cannot be nil"))
|
|
|
|
|
(if sync
|
|
|
|
|
(progn
|
|
|
|
|
(el-get-verbose-message "Running commands synchronously: %S" commands)
|
|
|
|
|
(let* ((startf (if shell #'call-process-shell-command #'call-process))
|
|
|
|
|
(infile (when stdin (make-temp-file "el-get")))
|
|
|
|
|
(dummy (when infile
|
|
|
|
|
(with-temp-file infile
|
|
|
|
|
(insert (el-get-print-to-string stdin)))))
|
|
|
|
|
(dummy (message "el-get is waiting for %S to complete" cname))
|
|
|
|
|
(status (apply startf program infile cbuf t args))
|
|
|
|
|
(message (plist-get c :message))
|
|
|
|
|
(errorm (plist-get c :error)))
|
|
|
|
|
(when el-get-verbose
|
|
|
|
|
(message "%S" (with-current-buffer cbuf (buffer-string))))
|
|
|
|
|
(if (eq 0 status)
|
|
|
|
|
(message "el-get: %s" message)
|
|
|
|
|
(set-window-buffer (selected-window) cbuf)
|
|
|
|
|
(error "el-get: %s %s" cname errorm))
|
|
|
|
|
(when infile (delete-file infile))
|
|
|
|
|
(when cbuf (kill-buffer cbuf))
|
|
|
|
|
(if next
|
|
|
|
|
;; Prevent stack overflow on very long command
|
|
|
|
|
;; lists. This allows
|
|
|
|
|
;; `el-get-start-process-list' (but not other
|
|
|
|
|
;; functions) to recurse indefinitely.
|
|
|
|
|
(let ((max-specpdl-size (+ 100 max-specpdl-size)))
|
|
|
|
|
(el-get-start-process-list package next final-func))
|
|
|
|
|
(when (functionp final-func)
|
|
|
|
|
(funcall final-func package)))))
|
|
|
|
|
;; async case
|
|
|
|
|
(el-get-verbose-message "Running commands asynchronously: %S" commands)
|
2021-02-14 16:35:29 +08:00
|
|
|
|
(let* ((process-connection-type nil) ; pipe, don't pretend we're a pty
|
|
|
|
|
(proc (if shell
|
|
|
|
|
(start-process-shell-command cname
|
|
|
|
|
cbuf
|
2021-06-12 04:23:45 +08:00
|
|
|
|
(mapconcat #'identity (cons program args) " "))
|
2021-02-14 16:35:29 +08:00
|
|
|
|
(apply #'start-process cname cbuf program args))))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
;; add the properties to the process, then set the sentinel
|
|
|
|
|
(mapc (lambda (x) (process-put proc x (plist-get c x))) c)
|
|
|
|
|
(process-put proc :el-get-sources el-get-sources)
|
|
|
|
|
(process-put proc :el-get-package package)
|
|
|
|
|
(process-put proc :el-get-final-func final-func)
|
|
|
|
|
(process-put proc :el-get-start-process-list next)
|
|
|
|
|
(when stdin
|
|
|
|
|
(process-send-string proc (el-get-print-to-string stdin))
|
|
|
|
|
(process-send-eof proc))
|
|
|
|
|
(set-process-sentinel proc 'el-get-start-process-list-sentinel)
|
|
|
|
|
(when filter (set-process-filter proc filter)))))
|
|
|
|
|
;; no commands, still run the final-func
|
|
|
|
|
(when (functionp final-func)
|
|
|
|
|
(funcall final-func package)))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
((debug error)
|
|
|
|
|
(el-get-installation-failed package err))))
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; get an executable given its command name, with friendly error message
|
|
|
|
|
;;
|
|
|
|
|
(defun el-get-executable-find (name)
|
|
|
|
|
"Return the absolute path of the command to execute, and errors
|
|
|
|
|
out if that can not be found.
|
|
|
|
|
|
|
|
|
|
This function will first look for existing function named
|
|
|
|
|
\"el-get-NAME-executable\" and call that. This function, if it
|
|
|
|
|
exists, must handle error cases.
|
|
|
|
|
|
|
|
|
|
Then, it will look for existing variable named \"el-get-NAME\"
|
|
|
|
|
and error if that's not nil and not an existing file name.
|
|
|
|
|
|
|
|
|
|
Baring variable named \"el-get-NAME\", it will call
|
|
|
|
|
`executable-find' on NAME and use the output of that, or error
|
|
|
|
|
out if it's nil."
|
|
|
|
|
(let ((fname (intern (format "el-get-%s-executable" name)))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(vname (intern (format "el-get-%s" name))))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(cond
|
|
|
|
|
((fboundp fname)
|
|
|
|
|
(funcall fname))
|
|
|
|
|
|
|
|
|
|
;; vname is bound here, we want to check for the variable named vname
|
|
|
|
|
;; (bound-and-true-p vname) won't cut it
|
|
|
|
|
((ignore-errors (symbol-value vname))
|
|
|
|
|
(let ((command (symbol-value vname)))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(unless (and (file-exists-p command)
|
|
|
|
|
(file-executable-p command))
|
|
|
|
|
(error
|
|
|
|
|
(concat "The variable `%s' points to \"%s\", "
|
|
|
|
|
"which is not an executable file name on your system.")
|
|
|
|
|
name command))
|
|
|
|
|
command))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
|
|
|
|
(t
|
|
|
|
|
(let ((command (executable-find name)))
|
2014-02-22 02:52:48 +08:00
|
|
|
|
(unless command
|
|
|
|
|
(error
|
|
|
|
|
"The command named '%s' can not be found with `executable-find'"
|
|
|
|
|
name))
|
|
|
|
|
command)))))
|
2011-09-20 21:15:52 +08:00
|
|
|
|
|
2012-02-24 05:29:58 +08:00
|
|
|
|
(defun el-get-plist-get-with-default (plist prop def)
|
|
|
|
|
"Same as (plist-get PLIST PROP), but falls back to DEF.
|
|
|
|
|
|
|
|
|
|
Specifically, if (plist-member PLIST PROP) is nil, then returns
|
|
|
|
|
DEF instead. Note that having a property set to nil is not the
|
|
|
|
|
same as having it unset."
|
|
|
|
|
(if (plist-member plist prop)
|
|
|
|
|
(plist-get plist prop)
|
|
|
|
|
def))
|
|
|
|
|
(put 'el-get-plist-get-with-default 'lisp-indent-function
|
|
|
|
|
(get 'prog2 'lisp-indent-function))
|
|
|
|
|
|
2011-09-20 21:15:52 +08:00
|
|
|
|
(provide 'el-get-core)
|