summary refs log tree commit diff stats
path: root/lisp/yoke.el
blob: 4f40869dd8718741b41894eb3db25a383f4e5360 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
;;; yoke.el --- yoke packages in to your editing system  -*- lexical-binding: t; -*-
;; by C. Duckworth <acdw@acdw.net>
(provide 'yoke)
(require 'cl-lib)

(defgroup yoke nil
  "Customizations for yoke, a package manager thing."
  :group 'applications
  :prefix "yoke-")

(defcustom yoke-dir (locate-user-emacs-file "yoke")
  "Where yoke packages live."
  :type 'file)

(defun yoke-repo-local-p (repo)
  (string-match-p (rx bos (or "." "~" "/")) repo))

(defun yoke-repo-dir (pkg repo)
  (if (yoke-repo-local-p repo)
      (expand-file-name repo)
    (expand-file-name (format "%s" pkg) yoke-dir)))

(defun yoke-git (repo &optional dir)
  "Git REPO from the internet and put it into `yoke-dir'.
If DIR is passed, clone there; otherwise just clone.  Return the
directory created."
  (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo))))
    (unless (or (yoke-repo-local-p repo) (file-exists-p dir))
      (message "Downloading %S..." repo)
      (call-process "git" nil (get-buffer-create "*yoke*") nil
                    "clone" repo dir)
      (message "Downloading %S... done" repo))
    dir))

(defun yoke-lasso (pkg repo &optional load-path)
  "Add PKG to `load-path' so it can be used.
If PKG is not installed, install it from REPO.  Packages will be
installed to `yoke-dir'."
  (let* ((dir (yoke-repo-dir pkg repo)))
    (yoke-git repo dir)
    (cond
     ((file-exists-p dir)
      (when (or load-path dir)
        (add-to-list 'load-path (expand-file-name (or load-path dir))))
      ;; This bit is stolen from `straight'.
      (eval-and-compile (require 'autoload))
      (let ((generated-autoload-file
             (expand-file-name (format "%s-autoloads.el" pkg) dir))
            (backup-inhibited t)
	    (version-control 'never)
	    (message-log-max nil)
	    (inhibit-message t))
	(unless (file-exists-p generated-autoload-file)
	  (let ((find-file-hook nil)
		(write-file-functions nil)
		(debug-on-error nil)
		(left-margin 0))
	    (if (fboundp 'make-directory-autoloads)
		(make-directory-autoloads dir generated-autoload-file)
	      (and (fboundp 'update-directory-autoloads)
		   (update-directory-autoloads dir)))))
	(when-let ((buf (find-buffer-visiting generated-autoload-file)))
	  (kill-buffer buf))
        (load generated-autoload-file :noerror :nomessage)))
     (t (user-error "Directory \"%s\" doesn't exist." dir)))
    dir))

(defun yoke-get (key args)
  "Get KEY's value from ARGS, or return nil.
Similar-ish to `plist-get', but works on non-proper plists."
  (cond
   ((null args) nil)
   ((eq key (car args)) (cadr args))
   (t (yoke-get key (cdr args)))))

(defmacro when1 (test &rest body)
  "Like `when', but return the value of the test."
  (declare (indent 1))
  (let ((g (gensym)))
    `(let ((,g ,test))
       (when ,g
         ,@body
         ,g))))

(defun delete2 (list &rest elems)
  "Delete ELEM and the next item from LIST."
  (let ((r nil))
    (while (consp list)
      (if (member (car list) elems)
          (setq list (cdr list))
        (setq r (cons (car list) r)))
      (setq list (cdr list)))
    (reverse r)))

(defun eval-after-init (fn)
  "Evaluate FN after inititation, or now if Emacs is initialized.
FN is called with no arguments."
  (if after-init-time
      (funcall fn)
    (add-hook 'after-init-hook fn)))

(defmacro eval-after (features &rest body)
  "Evaluate BODY, but only after loading FEATURES.
FEATURES can be an atom or a list; as an atom it works like
`with-eval-after-load'.  The special feature `init' will evaluate
BODY after Emacs is finished initializing."
  (declare (indent 1)
	   (debug (form def-body)))
  (if (eq features 'init)
      `(eval-after-init (lambda () ,@body))
    (unless (listp features)
      (setq features (list features)))
    (if (null features)
	(macroexp-progn body)
      (let* ((this (car features))
	     (rest (cdr features)))
	`(with-eval-after-load ',this
	   (eval-after ,rest ,@body))))))

(defun yoke-pkg-name (pkg)
  (intern (format "yoke:%s" pkg)))

(cl-defmacro yoke (pkg
                   &optional repo
                   &body body
                   &key
                   after                ; :after (FEATURE...)
                   depends              ; :depends ((PKG REPO)...)
                   load                 ; :load DIRECTORY
                   (when t whenp)       ; :when PREDICATE
                   (unless nil unlessp)	; :unless PREDICATE
                   &allow-other-keys)
  "Yoke a PKG into your Emacs session."
  (declare (indent defun))
  (let ((name (yoke-pkg-name pkg))
        (body (delete2 body
                       :depends :when :unless :after :load)))
    `(cl-block ,name
       (condition-case e
           (let ((*yoke-name* ',name)
                 (*yoke-repo* ,repo)
                 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo))))
             ,@(cond
		((and whenp unlessp)
		 `((when (or (not ,when) ,unless)
		     (cl-return-from ,name nil))))
		(whenp `((unless ,when (cl-return-from ,name nil))))
		(unlessp `((when ,unless (cl-return-from ,name nil)))))
             ,@(cl-loop for (pkg* repo* load-path*) in depends
                        collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*)
                                     (cl-return-from ,name nil)))
             ,@(cond
                (repo `((yoke-lasso ',pkg ,repo ,load)))
                (load `((add-to-list 'load-path ,load))))
             ,@(if after
                   `((eval-after ,after ,@body))
                 body))
         (:success ',pkg)
         (t (message "%s: %s" ',name e))))))