Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

378 lines (339 sloc) 13.072 kb
;;; el-get --- 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
;; Please see the README.asciidoc file from the same distribution
;;
;;
;; Description of packages. (Code based on `describe-function').
;;
(require 'el-get-core)
(require 'cl)
(define-button-type 'el-get-help-package-def
:supertype 'help-xref
'help-function (lambda (package) (find-file (el-get-recipe-filename package)))
'help-echo (purecopy "mouse-2, RET: find package's recipe"))
(define-button-type 'el-get-help-install
:supertype 'help-xref
'help-function (lambda (package)
(when (y-or-n-p
(format "Do you really want to install `%s'? "
package))
(el-get-install package)))
'help-echo (purecopy "mouse-2, RET: install package"))
(define-button-type 'el-get-help-remove
:supertype 'help-xref
'help-function (lambda (package)
(when (y-or-n-p
(format "Do you really want to uninstall `%s'? "
package))
(el-get-remove package)))
'help-echo (purecopy "mouse-2, RET: remove package"))
(define-button-type 'el-get-help-update
:supertype 'help-xref
'help-function (lambda (package)
(when (y-or-n-p
(format "Do you really want to update `%s'? "
package))
(el-get-update package)))
'help-echo (purecopy "mouse-2, RET: update package"))
(define-button-type 'el-get-help-describe-package
:supertype 'help-xref
'help-function #'el-get-describe
'help-echo (purecopy "mouse-2, RET: describe package"))
(defun el-get-describe-princ-button (label regex type &rest args)
"Princ a new button with label LABEL.
The LABEL is made clickable by calling `help-xref-button' for a backwards
matching REGEX with TYPE and ARGS as parameter."
(princ label)
(with-current-buffer standard-output
(save-excursion
(re-search-backward regex nil t)
(apply #'help-xref-button 1 type args))))
(defun el-get-guess-website (package)
(let* ((type (el-get-package-type package))
(guesser (el-get-method type :guess-website)))
(when guesser
(funcall guesser package))))
(defun el-get-describe-1 (package)
(let* ((psym (el-get-as-symbol package))
(pname (symbol-name psym))
(status (el-get-read-package-status package))
(def (el-get-package-def pname))
(name (plist-get def :name))
(website (plist-get def :website))
(descr (plist-get def :description))
(type (plist-get def :type))
(url (plist-get def :url))
(depends (plist-get def :depends)))
(princ (format "%s is an `el-get' package. It is currently %s " name
(if status status "not installed")))
(cond
((string= status "installed")
(el-get-describe-princ-button "[update]" "\\[\\([^]]+\\)\\]"
'el-get-help-update package)
(el-get-describe-princ-button "[remove]" "\\[\\([^]]+\\)\\]"
'el-get-help-remove package))
((string= status "required")
(el-get-describe-princ-button "[update]" "\\[\\([^]]+\\)\\]"
'el-get-help-update package))
(t
(el-get-describe-princ-button "[install]" "\\[\\([^]]+\\)\\]"
'el-get-help-install package)))
(princ ".\n\n")
(let ((website (or website
(el-get-guess-website package))))
(when website
(el-get-describe-princ-button (format "Website: %s\n" website)
": \\(.+\\)" 'help-url website)))
(when descr
(princ (format "Description: %s\n" descr)))
(when depends
(if (listp depends)
(progn
(princ "Dependencies: ")
(loop for i in depends
do (el-get-describe-princ-button
(format "`%s'" i) "`\\([^`']+\\)"
'el-get-help-describe-package i)))
(princ "Dependency: ")
(el-get-describe-princ-button
(format "`%s'" depends) "`\\([^`']+\\)"
'el-get-help-describe-package depends))
(princ ".\n"))
(princ (format "The default installation method is %s %s\n\n" type
(if url (format "from %s" url) "")))
(princ "Full definition")
(let ((file (el-get-recipe-filename package)))
(if (not file)
(princ ":\n")
(el-get-describe-princ-button (format " in `%s':\n" file)
"`\\([^`']+\\)"
'el-get-help-package-def package)))
(princ (el-get-print-to-string def))))
(defun el-get-describe (package)
"Generate a description for PACKAGE."
(interactive
(list
(el-get-read-package-name "Describe")))
(if (null package)
(message "You didn't specify a package")
(help-setup-xref (list #'el-get-describe package)
(called-interactively-p 'interactive))
(save-excursion
(with-help-window (help-buffer)
(el-get-describe-1 package)
(with-current-buffer standard-output
(buffer-string))))))
;;
;; Package Menu
;;
(defvar el-get-package-menu-mode-hook nil
"Hooks to run after el-get package menu init.")
(defvar el-get-package-menu-mode-map nil
"Keymap for el-get-package-menu-mode")
(defvar el-get-package-menu-sort-key nil
"sort packages by key")
(defun el-get-package-menu-get-package-name ()
(save-excursion
(beginning-of-line)
(if (looking-at ". \\([^ \t]*\\)")
(match-string 1))))
(defun el-get-package-menu-get-status ()
(save-excursion
(beginning-of-line)
(if (looking-at ". [^ \t]*[ \t]*\\([^ \t\n]*\\)")
(match-string 1))))
(defun el-get-package-menu-mark (what)
(unless (eobp)
(let ((buffer-read-only nil))
(beginning-of-line)
(delete-char 1)
(insert what)
(forward-line)
(setq buffer-read-only t))))
(defun el-get-package-menu-mark-install ()
(interactive)
(if (or (string= (el-get-package-menu-get-status) "available")
(string= (el-get-package-menu-get-status) "removed"))
(el-get-package-menu-mark "I")))
(defun el-get-package-menu-mark-update ()
(interactive)
(if (or (string= (el-get-package-menu-get-status) "installed")
(string= (el-get-package-menu-get-status) "required"))
(el-get-package-menu-mark "U")))
(defun el-get-package-menu-mark-delete ()
(interactive)
(if (or (string= (el-get-package-menu-get-status) "installed")
(string= (el-get-package-menu-get-status) "required"))
(el-get-package-menu-mark "D")))
(defun el-get-package-menu-mark-unmark ()
(interactive)
(el-get-package-menu-mark " "))
(defun el-get-package-menu-revert ()
(interactive)
(let ((current-point (point)))
(el-get-package-menu)
(goto-char current-point)
(beginning-of-line)))
(defun el-get-package-menu-execute ()
(interactive)
(let ((current-point (point)))
(goto-char (point-min))
(while (not (eobp))
(let ((command (char-after))
(package-name (el-get-package-menu-get-package-name)))
(cond
((eq command ?I)
(message "Installing %s..." package-name)
(el-get-install package-name)
(message "Installing %s...done" package-name))
((eq command ?U)
(message "Updating %s..." package-name)
(el-get-update package-name)
(message "Updating %s...done" package-name))
((eq command ?D)
(message "Deleting %s..." package-name)
(el-get-remove package-name)
(message "Deleting %s..." package-name))))
(forward-line))
(el-get-package-menu-revert)
(goto-char current-point)
(beginning-of-line)))
(defun el-get-package-menu-describe ()
(interactive)
(el-get-describe (el-get-package-menu-get-package-name)))
(defun el-get-package-menu-quick-help ()
(interactive)
(message "n-ext, p-revious, i-nstall, u-pdate, d-elete, SPC-unmark, g-revert, x-execute, ?-package describe, h-elp, q-uit"))
(unless el-get-package-menu-mode-map
(setq el-get-package-menu-mode-map (make-keymap))
(suppress-keymap el-get-package-menu-mode-map)
(define-key el-get-package-menu-mode-map "n" 'next-line)
(define-key el-get-package-menu-mode-map "p" 'previous-line)
(define-key el-get-package-menu-mode-map "i" 'el-get-package-menu-mark-install)
(define-key el-get-package-menu-mode-map "u" 'el-get-package-menu-mark-update)
(define-key el-get-package-menu-mode-map "d" 'el-get-package-menu-mark-delete)
(define-key el-get-package-menu-mode-map " " 'el-get-package-menu-mark-unmark)
(define-key el-get-package-menu-mode-map "g" 'el-get-package-menu-revert)
(define-key el-get-package-menu-mode-map "x" 'el-get-package-menu-execute)
(define-key el-get-package-menu-mode-map "?" 'el-get-package-menu-describe)
(define-key el-get-package-menu-mode-map "h" 'el-get-package-menu-quick-help)
(define-key el-get-package-menu-mode-map "q" 'quit-window))
(defun el-get-package-menu-mode ()
"Major mode for browsing a list of packages."
(kill-all-local-variables)
(use-local-map el-get-package-menu-mode-map)
(setq major-mode 'el-get-package-menu-mode)
(setq mode-name "Package-Menu")
(setq buffer-read-only t)
(setq truncate-lines t)
(if (fboundp 'run-mode-hooks)
(run-mode-hooks 'el-get-package-menu-mode-hook)
(run-hooks 'el-get-package-menu-mode-hook)))
(defun el-get-print-package (package-name status desc)
(let ((face
(cond
((string= status "installed")
'font-lock-comment-face)
((string= status "required")
'font-lock-keyword-face)
((string= status "removed")
'font-lock-string-face)
(t
(setq status "available")
'default))))
(indent-to 2 1)
(insert (propertize package-name 'font-lock-face face))
(indent-to 30 1)
(insert (propertize status 'font-lock-face face))
(when desc
(indent-to 41 1)
(insert (propertize
(replace-regexp-in-string "\n" " " desc)
'font-lock-face face)))
(insert "\n")))
(defun el-get-list-all-packages ()
(with-current-buffer (get-buffer-create "*el-get packages*")
(setq buffer-read-only nil)
(erase-buffer)
(let ((packages (el-get-read-all-recipes)))
(let ((selector (cond
((string= el-get-package-menu-sort-key "Status")
#'(lambda (package)
(let ((package-name (el-get-as-string (plist-get package :name))))
(el-get-read-package-status package-name))))
((string= el-get-package-menu-sort-key "Description")
#'(lambda (package)
(plist-get package :description)))
(t
#'(lambda (package)
(el-get-as-string (plist-get package :name)))))))
(setq packages
(sort packages
(lambda (left right)
(let ((vleft (funcall selector left))
(vright (funcall selector right)))
(string< vleft vright))))))
(mapc (lambda (package)
(let ((package-name (el-get-as-string (plist-get package :name))))
(el-get-print-package package-name
(el-get-read-package-status package-name)
(plist-get package :description))))
packages))
(goto-char (point-min))
(current-buffer)))
(defun el-get-package-menu-sort-by-column (&optional e)
"Sort the package menu by the last column clicked on."
(interactive (list last-input-event))
(if e (mouse-select-window e))
(let* ((pos (event-start e))
(obj (posn-object pos))
(col (if obj
(get-text-property (cdr obj) 'column-name (car obj))
(get-text-property (posn-point pos) 'column-name))))
(setq el-get-package-menu-sort-key col)
(el-get-package-menu)))
(defvar el-get-package-menu-sort-button-map
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1] 'el-get-package-menu-sort-by-column)
(define-key map [follow-link] 'mouse-face)
map)
"Local keymap for package menu sort buttons.")
(defun el-get-package-menu ()
(with-current-buffer (el-get-list-all-packages)
(el-get-package-menu-mode)
(setq header-line-format
(mapconcat
(lambda (pair)
(let ((column (car pair))
(name (cdr pair)))
(concat
;; Insert a space that aligns the button properly.
(propertize " " 'display (list 'space :align-to column)
'face 'fixed-pitch)
;; Set up the column button.
(propertize name
'column-name name
'help-echo "mouse-1: sort by column"
'mouse-face 'highlight
'keymap el-get-package-menu-sort-button-map))))
'((2 . "Package")
(30 . "Status")
(41 . "Description"))
""))
(pop-to-buffer (current-buffer))))
;;;###autoload
(defun el-get-list-packages ()
"Display a list of packages."
(interactive)
(el-get-package-menu))
(provide 'el-get-list-packages)
Jump to Line
Something went wrong with that request. Please try again.