el-get/el-get-bundle.el
Stephan Creutz ccca97f226 Replace cl by cl-lib
Since Emacs 27 the package cl is deprecated, the replacement is
cl-lib, which is available since Emacs 24.3.

This patch replaces cl by cl-lib and drops support for Emacs versions
less than 24.3. Dropping older Emacsen is required, because cl-lib is
a builtin starting from version 24.3 and doesn't need an extra package
from ELPA.

Testcases for past issues still contain cl. Most of them seem to be
broken and need further investigation.

This patch is tested with test/run-ert.sh, which outputs:

Ran 10 tests, 10 results as expected, 0 unexpected (2021-01-30 13:24:54+0100, 0.672122 sec)
1 expected failures

and manually by daily usage for a month now.
2021-06-13 16:03:08 +02:00

319 lines
12 KiB
EmacsLisp

;;; el-get-bundle.el --- An el-get wrapper
;; Author: INA Lintaro <tarao.gnn at gmail.com>
;; URL: https://github.com/tarao/bundle-el/tree/el-get
;; Version: 0.1
;; Keywords: emacs package install compile
;; Licence: WTFPL, grab your copy here: http://sam.zoy.org/wtfpl/
;; This file is NOT part of GNU Emacs.
;;; Code:
(require 'el-get)
(eval-when-compile (require 'cl-lib))
;; customization
(defgroup el-get-bundle nil "el-get-bundle"
:group 'el-get)
(defcustom el-get-bundle-byte-compile t
"t means to automatically byte-compile init forms."
:type 'boolean
:group 'el-get-bundle)
(defcustom el-get-bundle-sync t
"t means to run el-get with the argument 'sync.
The default can be overriden on a per-package basis by adding one of
`:bundle-async [t|nil]'
`:bundle-sync [t|nil]
to the list of keywords that follow
`el-get-bundle PACKAGE|el-get-bundle FEATURE in PACKAGE'."
:type 'boolean
:group 'el-get-bundle)
(defcustom el-get-bundle-init-directory
(expand-file-name "bundle-init/" el-get-dir)
"Directory to save auto generated init files."
:type 'directory
:group 'el-get-bundle)
(defvar el-get-bundle-sources nil)
(defvar el-get-bundle-init-count-alist nil)
(defvar el-get-bundle-init-alist nil)
(defconst el-get-bundle-gist-url-type-plist
'(http "http://gist.github.com/%s.git"
https "https://gist.github.com/%s.git"
git "git://gist.github.com/%s.git"
ssh "git@gist.github.com:%s.git")
"Plist mapping Gist types to their URL format strings.")
;; internals
(defsubst el-get-bundle-gist-url (id &optional src)
(let* ((type (or (plist-get src :url-type) el-get-github-default-url-type))
(str (or (plist-get el-get-bundle-gist-url-type-plist type)
(plist-get el-get-bundle-gist-url-type-plist 'http))))
(format str id)))
(defsubst el-get-bundle-load-file-el (&optional file)
(let ((file (or file load-file-name)))
(and file
(replace-regexp-in-string "\\.elc$" ".el" (expand-file-name file)))))
(defun el-get-bundle-package-def (src)
(ignore-errors
(let (el-get-sources)
(el-get-package-def (if (listp src) (el-get-source-name src) src)))))
(defalias 'el-get-bundle-defined-p (symbol-function 'el-get-bundle-package-def))
(defun el-get-bundle-guess-type (src)
(cond
((plist-member src :url)
(let ((url (plist-get src :url)))
(cond
((or (string-match-p "^git:" url) (string-match-p "\\.git$" url))
'git)
((or (string-match-p "^bzr:" url) (string-match-p "^lp:" url))
'bzr)
((string-match-p "^svn:" url)
'svn)
((string-match-p ":pserver:" url)
'cvs)
((string-match-p "ftp://" url)
'ftp)
((or (string-match-p "https?://" url) (string-match-p "\\.el$" url))
'http))))
(t 'elpa)))
(defun el-get-bundle-parse-name (sym)
(let ((spec (split-string (format "%s" sym) ":")) s)
(when (string= (or (nth 0 spec) "") "github") (setq spec (cdr spec)))
(cond
((and (> (length spec) 2) (string= (car spec) "gist"))
;; gist:12345:name
(let* ((id (nth 1 spec))
(name (intern (or (nth 2 spec) id)))
(type 'git) (url (el-get-bundle-gist-url id)))
(plist-put (plist-put (plist-put s :name name) :type type) :url url)))
((> (length spec) 1)
;; type:name
(let ((name (intern (nth 1 spec))) (type (intern (nth 0 spec))))
(plist-put (plist-put s :name name) :type type)))
((= (length (split-string (or (nth 0 spec) "") "/")) 2)
;; user/repository
(let ((name (intern (replace-regexp-in-string "^.*/" "" (nth 0 spec))))
(type 'github) (pkgname (nth 0 spec)))
(plist-put (plist-put (plist-put s :name name) :type type)
:pkgname pkgname)))
(t (plist-put s :name sym)))))
(defun el-get-bundle-init-id (callsite)
(let ((pair (assoc callsite el-get-bundle-init-count-alist)))
(if pair
(setcdr pair (1+ (cdr pair)))
(push (cons callsite 1) el-get-bundle-init-count-alist)
1)))
(defun el-get-bundle-load-init (el)
(el-get-byte-compile-file el byte-compile-warnings)
(load (expand-file-name (file-name-sans-extension el))))
(defun el-get-bundle-make-init (src)
(when (and el-get-bundle-byte-compile
(plist-get src :after)
load-file-name
(ignore-errors
(or (file-exists-p el-get-bundle-init-directory)
(make-directory el-get-bundle-init-directory t) t)))
(let* ((path (expand-file-name (convert-standard-filename load-file-name)))
(path (file-name-sans-extension path))
(callsite (replace-regexp-in-string "[^a-zA-Z0-9._-]" "_" path))
(package (plist-get src :name))
(id (el-get-bundle-init-id path))
(init-file (concat el-get-bundle-init-directory
(format "%s-%d_%s" callsite id package)))
(el (concat init-file ".el"))
(form (plist-get src :after))
(loader load-file-name))
(let ((loader-el (concat (file-name-sans-extension loader) ".el")))
(when (and (string-match-p "\\.elc$" loader)
(file-exists-p loader-el))
(setq loader loader-el)))
;; remember the package-initializer relation
(let* ((pair (assoc package el-get-bundle-init-alist))
(inits (cdr pair)))
(if pair
(setcdr pair (add-to-list 'inits init-file))
(push (cons package (list init-file)) el-get-bundle-init-alist)))
;; generate .el file
(when (or (not (file-exists-p el))
(file-newer-than-file-p loader el))
(with-temp-buffer
(if (listp form)
(dolist (exp form) (pp exp (current-buffer)))
(pp form (current-buffer)))
(write-region nil nil el)))
;; loader
`((el-get-bundle-load-init ,el)))))
;;;###autoload
(defun el-get-bundle-el-get (src sync)
(let ((package (plist-get src :name)) (def (el-get-bundle-package-def src))
(fs (plist-get src :features))
(ds (plist-get src :depends)))
;; merge features
(when (plist-member def :features)
(let ((old (el-get-as-list (plist-get def :features))))
(dolist (f old) (add-to-list 'fs f))
(setq src (plist-put src :features fs))))
;; merge depends
(when (plist-member def :depends)
(let ((old (el-get-as-list (plist-get def :depends))))
(dolist (d old) (add-to-list 'ds d))
(setq src (plist-put src :depends ds))))
;; merge src with the oriiginal definition
(setq def (let ((el-get-sources (list src)))
(el-get-package-def (el-get-source-name src))))
;; entering password via process-filter only works in async mode
(when (or (and (eq (plist-get def :type) 'cvs)
(eq (plist-get def :options) 'login)
(not (string-match-p "^:pserver:.*:.*@.*:.*$"
(or (plist-get def :url) ""))))
(eq (plist-get def :type) 'apt)
(eq (plist-get def :type) 'fink)
(eq (plist-get def :type) 'pacman))
(setq sync nil))
;; byte-compile :after script
(let ((form (or (el-get-bundle-make-init def) (plist-get def :after))))
(when form
(setq def (plist-put def :after `(progn ,@form)))))
(let ((toplevel (null el-get-bundle-sources)))
;; save sources to global variable
(when toplevel (setq el-get-bundle-sources el-get-sources))
(add-to-list 'el-get-bundle-sources def)
;; get
(prog1 (let ((el-get-sources el-get-bundle-sources))
(el-get sync package))
;; prevent :after from running twice
(plist-put def :after nil)
;; apply changes of sources to `el-get-sources' variable
(when toplevel
(setq el-get-sources el-get-bundle-sources
el-get-bundle-sources nil))))))
(defun el-get-bundle-post-update (package)
"Post update process for PACKAGE.
Invalidate byte-compiled package initialization forms of
PACKAGE (for future recompilation)."
(let ((inits (assoc package el-get-bundle-init-alist)))
(dolist (name (cdr (assoc package el-get-bundle-init-alist)))
(let ((file (concat name ".elc")))
(when (file-exists-p file)
(delete-file file))))))
(add-hook 'el-get-post-update-hooks #'el-get-bundle-post-update)
(defun el-get-bundle-clear-init-count (callsite)
;; clear the number of configurations so that the number starts with
;; 1 next time CALLSITE is loaded
(let ((key (file-name-sans-extension (expand-file-name callsite))))
(setq el-get-bundle-init-count-alist
(delq (assoc key el-get-bundle-init-count-alist)
el-get-bundle-init-count-alist))))
(add-hook 'after-load-functions #'el-get-bundle-clear-init-count)
;; commands
;;;###autoload
(defmacro el-get-bundle (package &rest form)
"Install PACKAGE and run initialization FORM.
PACKAGE can be either a simple package name or a package name
with a modifier before the name to specify local recipe source
information:
* `<owner>/' : specifies a Github owner name
* `gist:<id>' : specifies a Gist ID
* `<type>:' : specifies a type of the package source
If `FEATURE in PACKAGE' form is used instead of PACKAGE, then
that FEATURE is `require'd after installing PACKAGE. You can
also use `el-get-bundle!' macro if FEATURE and PACKAGE are the
same. If you wish to `require' more than one feature, then use
`:features' property in FORM.
The initialization FORM may start with a property list that
describes a local recipe. The property list may include the keyword
`:bundle-sync' with a value of either `t' or `nil' to request that
`el-get-bundle' invoke `el-get' synchronously (respectively asynchronously).
The keyword `:bundle-async' is the inverse of `:bundle-sync'.
\(Note that the request to run el-get synchronously may not be respected in all
circumstances: see the definition of `el-get-bundle-el-get' for details.)
The FORM after the property list is treated as initialization code,
which is actually an `:after' property of the local recipe.
A copy of the initialization code is stored in a directory
specified by `el-get-bundle-init-directory' and its byte-compiled
version is used if `el-get-bundle-byte-compile' is non-nil."
(declare (indent defun) (debug t))
(let* ((package (or (and (listp package) (nth 1 package)) package))
(src (el-get-bundle-parse-name package))
(sync el-get-bundle-sync) require)
;; set parsed name
(setq package (plist-get src :name))
;; (el-get-bundle FEATURE in PACKAGE ...) form
(when (eq (nth 0 form) 'in)
(let* ((name (nth 1 form))
(name (or (and (listp name) (nth 1 name)) name)))
(setq src (el-get-bundle-parse-name name)))
(setq form (nthcdr 2 form) require t))
;; parse keywords
(while (keywordp (nth 0 form))
(cl-case (nth 0 form)
(:bundle-sync (setq sync (nth 1 form)))
(:bundle-async (setq sync (not (nth 1 form))))
(t (setq src (plist-put src (nth 0 form) (nth 1 form)))))
(setq form (cdr-safe (cdr form))))
;; put default type
(unless (or (plist-member src :type) (el-get-bundle-defined-p src))
(setq src (plist-put src :type (el-get-bundle-guess-type src))))
;; features
(when (plist-member src :features)
(let ((fs (el-get-as-list (plist-get src :features))))
(setq src (plist-put src :features fs))))
(when (and require (or (not (plist-member src :features))
(plist-get src :features)))
;; put the feature into the features list
(let ((fs (plist-get src :features)))
(add-to-list 'fs package)
(setq src (plist-put src :features fs))))
;; init script
(setq src (plist-put src :after form))
`(el-get-bundle-el-get ',src ',(when sync 'sync))))
;;;###autoload
(defmacro el-get-bundle! (package &rest args)
"Install PACKAGE and run initialization form.
It is the same as `el-get-bundle' except that PACKAGE is explicitly
required."
(declare (indent defun) (debug t))
(if (eq (nth 0 args) 'in)
`(el-get-bundle ,package ,@args)
(let* ((package (or (and (listp package) (nth 1 package)) package))
(name (plist-get (el-get-bundle-parse-name package) :name)))
`(el-get-bundle ,name ,@(cl-list* 'in package args)))))
(provide 'el-get-bundle)
;;; el-get-bundle.el ends here