mirror of
https://github.com/dimitri/el-get.git
synced 2024-09-30 05:29:52 +08:00
394 lines
13 KiB
EmacsLisp
394 lines
13 KiB
EmacsLisp
;;; 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))))))
|
||
|
||
(defcustom el-get-package-menu-view-recipe-function
|
||
'find-file-other-window
|
||
"`find-file' compatible function used to display recipe content
|
||
in el-get package menu."
|
||
:group 'el-get
|
||
:type 'symbol)
|
||
|
||
|
||
;;
|
||
;; 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-view-recipe ()
|
||
"Show package recipe in a read-only mode."
|
||
(interactive)
|
||
(let* ((package (el-get-package-menu-get-package-name))
|
||
(recipe-file (el-get-recipe-filename package)))
|
||
(funcall el-get-package-menu-view-recipe-function recipe-file)
|
||
(view-mode)))
|
||
|
||
(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, v-iew recipe, 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 "v" 'el-get-package-menu-view-recipe)
|
||
(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)
|