Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 378 lines (339 sloc) 13.072 kB
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
1 ;;; el-get --- Manage the external elisp bits and pieces you depend upon
2 ;;
3 ;; Copyright (C) 2010-2011 Dimitri Fontaine
4 ;;
5 ;; Author: Dimitri Fontaine <dim@tapoueh.org>
6 ;; URL: http://www.emacswiki.org/emacs/el-get
7 ;; GIT: https://github.com/dimitri/el-get
8 ;; Licence: WTFPL, grab your copy here: http://sam.zoy.org/wtfpl/
9 ;;
10 ;; This file is NOT part of GNU Emacs.
11 ;;
12 ;; Install
13 ;; Please see the README.asciidoc file from the same distribution
14
15 ;;
16 ;;
17 ;; Description of packages. (Code based on `describe-function').
18 ;;
59c8c44 @DarwinAwardWinner Add support for method website guessers
DarwinAwardWinner authored
19 (require 'el-get-core)
20 (require 'cl)
21
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
22 (define-button-type 'el-get-help-package-def
23 :supertype 'help-xref
24 'help-function (lambda (package) (find-file (el-get-recipe-filename package)))
25 'help-echo (purecopy "mouse-2, RET: find package's recipe"))
26
27 (define-button-type 'el-get-help-install
28 :supertype 'help-xref
29 'help-function (lambda (package)
30 (when (y-or-n-p
31 (format "Do you really want to install `%s'? "
32 package))
33 (el-get-install package)))
34 'help-echo (purecopy "mouse-2, RET: install package"))
35
36 (define-button-type 'el-get-help-remove
37 :supertype 'help-xref
38 'help-function (lambda (package)
39 (when (y-or-n-p
40 (format "Do you really want to uninstall `%s'? "
41 package))
42 (el-get-remove package)))
43 'help-echo (purecopy "mouse-2, RET: remove package"))
44
45 (define-button-type 'el-get-help-update
46 :supertype 'help-xref
47 'help-function (lambda (package)
48 (when (y-or-n-p
49 (format "Do you really want to update `%s'? "
50 package))
51 (el-get-update package)))
52 'help-echo (purecopy "mouse-2, RET: update package"))
53
54 (define-button-type 'el-get-help-describe-package
55 :supertype 'help-xref
56 'help-function #'el-get-describe
57 'help-echo (purecopy "mouse-2, RET: describe package"))
58
59 (defun el-get-describe-princ-button (label regex type &rest args)
60 "Princ a new button with label LABEL.
61
62 The LABEL is made clickable by calling `help-xref-button' for a backwards
63 matching REGEX with TYPE and ARGS as parameter."
64 (princ label)
65 (with-current-buffer standard-output
66 (save-excursion
67 (re-search-backward regex nil t)
68 (apply #'help-xref-button 1 type args))))
69
59c8c44 @DarwinAwardWinner Add support for method website guessers
DarwinAwardWinner authored
70 (defun el-get-guess-website (package)
71 (let* ((type (el-get-package-type package))
72 (guesser (el-get-method type :guess-website)))
73 (when guesser
74 (funcall guesser package))))
57ff1cc el-get-describe: guess a project's github URL if no website was defin…
Kyle Hargraves authored
75
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
76 (defun el-get-describe-1 (package)
77 (let* ((psym (el-get-as-symbol package))
78 (pname (symbol-name psym))
79 (status (el-get-read-package-status package))
80 (def (el-get-package-def pname))
81 (name (plist-get def :name))
82 (website (plist-get def :website))
83 (descr (plist-get def :description))
84 (type (plist-get def :type))
85 (url (plist-get def :url))
86 (depends (plist-get def :depends)))
87 (princ (format "%s is an `el-get' package. It is currently %s " name
88 (if status status "not installed")))
89
90 (cond
91 ((string= status "installed")
92 (el-get-describe-princ-button "[update]" "\\[\\([^]]+\\)\\]"
93 'el-get-help-update package)
94 (el-get-describe-princ-button "[remove]" "\\[\\([^]]+\\)\\]"
95 'el-get-help-remove package))
96 ((string= status "required")
97 (el-get-describe-princ-button "[update]" "\\[\\([^]]+\\)\\]"
98 'el-get-help-update package))
99 (t
100 (el-get-describe-princ-button "[install]" "\\[\\([^]]+\\)\\]"
101 'el-get-help-install package)))
102 (princ ".\n\n")
103
57ff1cc el-get-describe: guess a project's github URL if no website was defin…
Kyle Hargraves authored
104 (let ((website (or website
59c8c44 @DarwinAwardWinner Add support for method website guessers
DarwinAwardWinner authored
105 (el-get-guess-website package))))
57ff1cc el-get-describe: guess a project's github URL if no website was defin…
Kyle Hargraves authored
106 (when website
107 (el-get-describe-princ-button (format "Website: %s\n" website)
108 ": \\(.+\\)" 'help-url website)))
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
109 (when descr
110 (princ (format "Description: %s\n" descr)))
111 (when depends
112 (if (listp depends)
113 (progn
114 (princ "Dependencies: ")
115 (loop for i in depends
116 do (el-get-describe-princ-button
117 (format "`%s'" i) "`\\([^`']+\\)"
118 'el-get-help-describe-package i)))
119 (princ "Dependency: ")
120 (el-get-describe-princ-button
121 (format "`%s'" depends) "`\\([^`']+\\)"
122 'el-get-help-describe-package depends))
123 (princ ".\n"))
124 (princ (format "The default installation method is %s %s\n\n" type
125 (if url (format "from %s" url) "")))
126 (princ "Full definition")
127 (let ((file (el-get-recipe-filename package)))
128 (if (not file)
129 (princ ":\n")
130 (el-get-describe-princ-button (format " in `%s':\n" file)
131 "`\\([^`']+\\)"
132 'el-get-help-package-def package)))
cb787b2 @DarwinAwardWinner Always print with "print-level" and "print-length" nil
DarwinAwardWinner authored
133 (princ (el-get-print-to-string def))))
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
134
135 (defun el-get-describe (package)
136 "Generate a description for PACKAGE."
137 (interactive
138 (list
139 (el-get-read-package-name "Describe")))
140
141 (if (null package)
142 (message "You didn't specify a package")
143 (help-setup-xref (list #'el-get-describe package)
144 (called-interactively-p 'interactive))
145 (save-excursion
146 (with-help-window (help-buffer)
147 (el-get-describe-1 package)
148 (with-current-buffer standard-output
149 (buffer-string))))))
150
151
152 ;;
153 ;; Package Menu
154 ;;
155 (defvar el-get-package-menu-mode-hook nil
156 "Hooks to run after el-get package menu init.")
157
158 (defvar el-get-package-menu-mode-map nil
159 "Keymap for el-get-package-menu-mode")
160
161 (defvar el-get-package-menu-sort-key nil
162 "sort packages by key")
163
164 (defun el-get-package-menu-get-package-name ()
165 (save-excursion
166 (beginning-of-line)
167 (if (looking-at ". \\([^ \t]*\\)")
168 (match-string 1))))
169
170 (defun el-get-package-menu-get-status ()
171 (save-excursion
172 (beginning-of-line)
173 (if (looking-at ". [^ \t]*[ \t]*\\([^ \t\n]*\\)")
174 (match-string 1))))
175
176 (defun el-get-package-menu-mark (what)
177 (unless (eobp)
178 (let ((buffer-read-only nil))
179 (beginning-of-line)
180 (delete-char 1)
181 (insert what)
182 (forward-line)
183 (setq buffer-read-only t))))
184
185 (defun el-get-package-menu-mark-install ()
186 (interactive)
187 (if (or (string= (el-get-package-menu-get-status) "available")
188 (string= (el-get-package-menu-get-status) "removed"))
189 (el-get-package-menu-mark "I")))
190
191 (defun el-get-package-menu-mark-update ()
192 (interactive)
193 (if (or (string= (el-get-package-menu-get-status) "installed")
194 (string= (el-get-package-menu-get-status) "required"))
195 (el-get-package-menu-mark "U")))
196
197 (defun el-get-package-menu-mark-delete ()
198 (interactive)
199 (if (or (string= (el-get-package-menu-get-status) "installed")
200 (string= (el-get-package-menu-get-status) "required"))
201 (el-get-package-menu-mark "D")))
202
203 (defun el-get-package-menu-mark-unmark ()
204 (interactive)
205 (el-get-package-menu-mark " "))
206
207 (defun el-get-package-menu-revert ()
208 (interactive)
209 (let ((current-point (point)))
210 (el-get-package-menu)
211 (goto-char current-point)
212 (beginning-of-line)))
213
214 (defun el-get-package-menu-execute ()
215 (interactive)
216 (let ((current-point (point)))
217 (goto-char (point-min))
218 (while (not (eobp))
219 (let ((command (char-after))
220 (package-name (el-get-package-menu-get-package-name)))
221 (cond
222 ((eq command ?I)
223 (message "Installing %s..." package-name)
224 (el-get-install package-name)
225 (message "Installing %s...done" package-name))
226 ((eq command ?U)
227 (message "Updating %s..." package-name)
228 (el-get-update package-name)
229 (message "Updating %s...done" package-name))
230 ((eq command ?D)
231 (message "Deleting %s..." package-name)
232 (el-get-remove package-name)
233 (message "Deleting %s..." package-name))))
234 (forward-line))
235 (el-get-package-menu-revert)
236 (goto-char current-point)
237 (beginning-of-line)))
238
239 (defun el-get-package-menu-describe ()
240 (interactive)
241 (el-get-describe (el-get-package-menu-get-package-name)))
242
243 (defun el-get-package-menu-quick-help ()
244 (interactive)
245 (message "n-ext, p-revious, i-nstall, u-pdate, d-elete, SPC-unmark, g-revert, x-execute, ?-package describe, h-elp, q-uit"))
246
247 (unless el-get-package-menu-mode-map
248 (setq el-get-package-menu-mode-map (make-keymap))
249 (suppress-keymap el-get-package-menu-mode-map)
250 (define-key el-get-package-menu-mode-map "n" 'next-line)
251 (define-key el-get-package-menu-mode-map "p" 'previous-line)
252 (define-key el-get-package-menu-mode-map "i" 'el-get-package-menu-mark-install)
253 (define-key el-get-package-menu-mode-map "u" 'el-get-package-menu-mark-update)
254 (define-key el-get-package-menu-mode-map "d" 'el-get-package-menu-mark-delete)
255 (define-key el-get-package-menu-mode-map " " 'el-get-package-menu-mark-unmark)
256 (define-key el-get-package-menu-mode-map "g" 'el-get-package-menu-revert)
257 (define-key el-get-package-menu-mode-map "x" 'el-get-package-menu-execute)
258 (define-key el-get-package-menu-mode-map "?" 'el-get-package-menu-describe)
259 (define-key el-get-package-menu-mode-map "h" 'el-get-package-menu-quick-help)
260 (define-key el-get-package-menu-mode-map "q" 'quit-window))
261
262 (defun el-get-package-menu-mode ()
263 "Major mode for browsing a list of packages."
264 (kill-all-local-variables)
265 (use-local-map el-get-package-menu-mode-map)
266 (setq major-mode 'el-get-package-menu-mode)
267 (setq mode-name "Package-Menu")
268 (setq buffer-read-only t)
269 (setq truncate-lines t)
270 (if (fboundp 'run-mode-hooks)
271 (run-mode-hooks 'el-get-package-menu-mode-hook)
272 (run-hooks 'el-get-package-menu-mode-hook)))
273
274 (defun el-get-print-package (package-name status desc)
275 (let ((face
276 (cond
277 ((string= status "installed")
278 'font-lock-comment-face)
279 ((string= status "required")
280 'font-lock-keyword-face)
281 ((string= status "removed")
282 'font-lock-string-face)
283 (t
284 (setq status "available")
285 'default))))
286 (indent-to 2 1)
287 (insert (propertize package-name 'font-lock-face face))
288 (indent-to 30 1)
289 (insert (propertize status 'font-lock-face face))
290 (when desc
291 (indent-to 41 1)
292 (insert (propertize
293 (replace-regexp-in-string "\n" " " desc)
294 'font-lock-face face)))
295 (insert "\n")))
296
297 (defun el-get-list-all-packages ()
298 (with-current-buffer (get-buffer-create "*el-get packages*")
299 (setq buffer-read-only nil)
300 (erase-buffer)
301 (let ((packages (el-get-read-all-recipes)))
302 (let ((selector (cond
303 ((string= el-get-package-menu-sort-key "Status")
304 #'(lambda (package)
305 (let ((package-name (el-get-as-string (plist-get package :name))))
b96ae5b @DarwinAwardWinner Remove reference to removed function
DarwinAwardWinner authored
306 (el-get-read-package-status package-name))))
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
307 ((string= el-get-package-menu-sort-key "Description")
308 #'(lambda (package)
309 (plist-get package :description)))
310 (t
311 #'(lambda (package)
312 (el-get-as-string (plist-get package :name)))))))
313 (setq packages
314 (sort packages
315 (lambda (left right)
316 (let ((vleft (funcall selector left))
317 (vright (funcall selector right)))
318 (string< vleft vright))))))
319 (mapc (lambda (package)
320 (let ((package-name (el-get-as-string (plist-get package :name))))
321 (el-get-print-package package-name
b96ae5b @DarwinAwardWinner Remove reference to removed function
DarwinAwardWinner authored
322 (el-get-read-package-status package-name)
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
323 (plist-get package :description))))
324 packages))
325 (goto-char (point-min))
326 (current-buffer)))
327
328 (defun el-get-package-menu-sort-by-column (&optional e)
329 "Sort the package menu by the last column clicked on."
330 (interactive (list last-input-event))
331 (if e (mouse-select-window e))
332 (let* ((pos (event-start e))
333 (obj (posn-object pos))
334 (col (if obj
335 (get-text-property (cdr obj) 'column-name (car obj))
336 (get-text-property (posn-point pos) 'column-name))))
337 (setq el-get-package-menu-sort-key col)
338 (el-get-package-menu)))
339
340 (defvar el-get-package-menu-sort-button-map
341 (let ((map (make-sparse-keymap)))
342 (define-key map [header-line mouse-1] 'el-get-package-menu-sort-by-column)
343 (define-key map [follow-link] 'mouse-face)
344 map)
345 "Local keymap for package menu sort buttons.")
346
347 (defun el-get-package-menu ()
348 (with-current-buffer (el-get-list-all-packages)
349 (el-get-package-menu-mode)
350 (setq header-line-format
351 (mapconcat
352 (lambda (pair)
353 (let ((column (car pair))
354 (name (cdr pair)))
355 (concat
356 ;; Insert a space that aligns the button properly.
357 (propertize " " 'display (list 'space :align-to column)
358 'face 'fixed-pitch)
359 ;; Set up the column button.
360 (propertize name
361 'column-name name
362 'help-echo "mouse-1: sort by column"
363 'mouse-face 'highlight
364 'keymap el-get-package-menu-sort-button-map))))
365 '((2 . "Package")
366 (30 . "Status")
367 (41 . "Description"))
368 ""))
369 (pop-to-buffer (current-buffer))))
370
491ed85 @jd Add missing autoload flags for interactive functions
jd authored
371 ;;;###autoload
0433ca0 @dimitri Refactoring it all: a beginning. No time for testing yet, just showi…
authored
372 (defun el-get-list-packages ()
373 "Display a list of packages."
374 (interactive)
375 (el-get-package-menu))
376
377 (provide 'el-get-list-packages)
Something went wrong with that request. Please try again.