Skip to content

HTTPS clone URL

Subversion checkout URL

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