You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

170 lines
6.7 KiB

;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2014 Thierry Volpiatto <thierry.volpiatto@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'package)
;; internals vars
(defvar helm-el-package--show-only 'all)
(defvar helm-el-package--initialized-p nil)
(defun helm-el-package--init ()
(when (null package-alist)
(setq helm-el-package--show-only 'all))
(save-selected-window
(list-packages helm-el-package--initialized-p)
(setq helm-el-package--initialized-p t)
(message nil))
(helm-init-candidates-in-buffer
'global
(with-current-buffer (get-buffer "*Packages*")
(buffer-string)))
(setq helm-el-package--show-only 'all)
(kill-buffer "*Packages*"))
(defun helm-el-package-describe (candidate)
(let ((id (get-text-property 0 'tabulated-list-id candidate)))
(describe-package (if (fboundp 'package-desc-name)
(package-desc-name id)
(car id)))))
(defun helm-el-package-install (_candidate)
(cl-loop with mkd = (helm-marked-candidates)
for p in mkd
for id = (get-text-property 0 'tabulated-list-id p)
do (package-install
(if (fboundp 'package-desc-name)
(package-desc-name id)
(car id)))
and collect (if (fboundp 'package-desc-full-name)
id
(car id))
into installed-list
finally do (if (fboundp 'package-desc-full-name)
(message (format "%d packages installed:\n(%s)"
(length installed-list)
(mapconcat #'package-desc-full-name
installed-list ", ")))
(message (format "%d packages installed:\n(%s)"
(length installed-list)
(mapconcat 'symbol-name installed-list ", "))))))
(defun helm-el-package-uninstall (_candidate)
(cl-loop with mkd = (helm-marked-candidates)
for p in mkd
for id = (get-text-property 0 'tabulated-list-id p)
do
(condition-case-unless-debug err
(with-no-warnings
(if (fboundp 'package-desc-full-name)
;; emacs 24.4
(package-delete id)
;; emacs 24.3
(package-delete (symbol-name (car id))
(package-version-join (cdr id)))))
(error (message (cadr err))))
and collect (if (fboundp 'package-desc-full-name)
id
(cons (symbol-name (car id))
(package-version-join (cdr id))))
into delete-list
finally do (if (fboundp 'package-desc-full-name)
;; emacs 24.4
(message (format "%d packages deleted:\n(%s)"
(length delete-list)
(mapconcat #'package-desc-full-name
delete-list ", ")))
;; emacs 24.3
(message (format "%d packages deleted:\n(%s)"
(length delete-list)
(mapconcat (lambda (x)
(concat (car x) "-" (cdr x)))
delete-list ", ")))
;; emacs 24.3 doesn't update
;; its `package-alist' after deleting.
(cl-loop for p in package-alist
when (assq (symbol-name (car p)) delete-list)
do (setq package-alist (delete p package-alist))))))
(defun helm-el-package--transformer (candidates _source)
(cl-loop for c in candidates
for id = (get-text-property 0 'tabulated-list-id c)
for installed-p = (assq (if (fboundp 'package-desc-name)
(package-desc-name id)
(car id))
package-alist)
for cand = (cons c (car (split-string c)))
when (or (and installed-p
(eq helm-el-package--show-only 'installed))
(and (not installed-p)
(eq helm-el-package--show-only 'uninstalled))
(eq helm-el-package--show-only 'all))
collect cand))
(defun helm-el-package-show-installed ()
(interactive)
(with-helm-alive-p
(setq helm-el-package--show-only 'installed)
(helm-update)))
(defun helm-el-package-show-all ()
(interactive)
(with-helm-alive-p
(setq helm-el-package--show-only 'all)
(helm-update)))
(defun helm-el-package-show-uninstalled ()
(interactive)
(with-helm-alive-p
(setq helm-el-package--show-only 'uninstalled)
(helm-update)))
(defvar helm-el-package-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-I") 'helm-el-package-show-installed)
(define-key map (kbd "M-U") 'helm-el-package-show-uninstalled)
(define-key map (kbd "M-A") 'helm-el-package-show-all)
(define-key map (kbd "C-c ?") 'helm-el-package-help)
map))
(defvar helm-source-list-el-package
`((name . "list packages")
(init . helm-el-package--init)
(get-line . buffer-substring)
(match-part . (lambda (c) (car (split-string c))))
(filtered-candidate-transformer . helm-el-package--transformer)
(candidates-in-buffer)
(mode-line . helm-el-package-mode-line)
(keymap . ,helm-el-package-map)
(candidate-number-limit . 9999)
(action . (("Describe" . helm-el-package-describe)
("Install" . helm-el-package-install)
("Uninstall" . helm-el-package-uninstall)))))
;;;###autoload
(defun helm-list-elisp-packages (arg)
(interactive "P")
(when arg (setq helm-el-package--initialized-p nil))
(helm :sources 'helm-source-list-el-package
:buffer "*helm list packages*"))
(provide 'helm-elisp-package)
;;; helm-elisp-package.el ends here