+++ /dev/null
-;;; paradox-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "paradox" "paradox.el" (0 0 0 0))
-;;; Generated autoloads from paradox.el
-
-(autoload 'paradox-list-packages "paradox" "\
-Improved version of `package-list-packages'. The heart of Paradox.
-Function is equivalent to `package-list-packages' (including the
-prefix NO-FETCH), but the resulting Package Menu is improved in
-several ways.
-
-Among them:
-
-1. Uses `paradox-menu-mode', which has more functionality and
-keybinds than `package-menu-mode'.
-
-2. Uses some font-locking to improve readability.
-
-3. Optionally shows the number GitHub stars and Melpa downloads
-for packages.
-
-4. Adds useful information in the mode-line.
-
-\(fn NO-FETCH)" t nil)
-
-(autoload 'paradox-upgrade-packages "paradox" "\
-Upgrade all packages. No questions asked.
-This function is equivalent to `list-packages', followed by a
-`package-menu-mark-upgrades' and a `package-menu-execute'. Except
-the user isn't asked to confirm deletion of packages.
-
-If `paradox-execute-asynchronously' is non-nil, part of this
-operation may be performed in the background.
-
-The NO-FETCH prefix argument is passed to `list-packages'. It
-prevents re-download of information about new versions. It does
-not prevent downloading the actual packages (obviously).
-
-\(fn &optional NO-FETCH)" t nil)
-
-(autoload 'paradox-require "paradox" "\
-Like `require', but also install FEATURE if it is absent.
-FILENAME is passed to `require'.
-If NOERROR is non-nil, don't complain if the feature couldn't be
-installed, just return nil.
-
-- If FEATURE is present, `require' it and return t.
-
-- If FEATURE is not present, install PACKAGE with `package-install'.
-If PACKAGE is nil, assume FEATURE is the package name.
-After installation, `require' FEATURE.
-
-By default, the current package database is only updated if it is
-empty. Passing a non-nil REFRESH argument forces this update.
-
-\(fn FEATURE &optional FILENAME NOERROR PACKAGE REFRESH)" nil nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paradox" '("paradox-")))
-
-;;;***
-\f
-;;;### (autoloads nil "paradox-commit-list" "paradox-commit-list.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from paradox-commit-list.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paradox-commit-list" '("paradox-")))
-
-;;;***
-\f
-;;;### (autoloads nil "paradox-core" "paradox-core.el" (0 0 0 0))
-;;; Generated autoloads from paradox-core.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paradox-core" '("paradox-")))
-
-;;;***
-\f
-;;;### (autoloads nil "paradox-execute" "paradox-execute.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from paradox-execute.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paradox-execute" '("paradox-")))
-
-;;;***
-\f
-;;;### (autoloads nil "paradox-github" "paradox-github.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from paradox-github.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paradox-github" '("paradox-")))
-
-;;;***
-\f
-;;;### (autoloads nil "paradox-menu" "paradox-menu.el" (0 0 0 0))
-;;; Generated autoloads from paradox-menu.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paradox-menu" '("paradox-")))
-
-;;;***
-\f
-;;;### (autoloads nil nil ("paradox-pkg.el") (0 0 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; paradox-autoloads.el ends here
+++ /dev/null
-;;; paradox-commit-list.el --- listing commits for a package's repository -*- lexical-binding:t -*-
-
-;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-;; Prefix: paradox
-;; Separator: -
-
-;;; License:
-;;
-;; This file is NOT part of GNU Emacs.
-;;
-;; 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 2
-;; 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.
-;;
-
-\f
-;;; Code:
-(require 'subr-x)
-(require 'cl-lib)
-(require 'package)
-
-(require 'paradox-github)
-
-(defgroup paradox-commit-list nil
- "Buffer used by paradox to list commits for a package."
- :prefix "paradox-"
- :package-version '(paradox . "2.0")
- :group 'paradox)
-
-\f
-;;; Variables
-(defcustom paradox-commit-list-query-max-pages 1
- "Max number of pages we read from github when fetching the commit-list.
-Each page lists 100 commits, so 1 page should be more than enough
-for most repositories.
-
-Increasing this number consequently multiplies the time it takes
-to load the commit list on repos which actually use that many
-pages."
- :type 'integer
- :group 'paradox-commit-list
- :package-version '(paradox . "1.2.3"))
-
-(defcustom paradox-date-format "%Y-%m-%d"
- "Format used for the date displayed on the commit list.
-See `format-time-string' for more information.
-
-Set it to \"%x\" for a more \"human\" date format."
- :type 'string
- :group 'paradox-commit-list
- :package-version '(paradox . "1.2.3"))
-
-(defface paradox-commit-tag-face
- '((t :foreground "goldenrod4"
- :background "LemonChiffon1"
- :box 1))
- "Face used for tags on the commit list."
- :group 'paradox-commit-list)
-
-\f
-;;; Variables
-(defvar paradox--commit-message-face nil
- "Face currently being used on commit messages.
-Gets dynamically changed to `font-lock-comment-face' on old commits.
-nil means `default'.")
-
-(defvar-local paradox--package-repo nil
- "Repo of the package in a commit-list buffer.")
-(defvar-local paradox--package-name nil
- "Name of the package in a commit-list buffer.")
-(defvar-local paradox--package-version nil
- "Installed version of the package in a commit-list buffer.")
-(defvar-local paradox--package-tag-commit-alist nil
- "Alist of (COMMIT-SHA . TAG) for this package's repo.")
-
-\f
-;;; Functions
-(defun paradox--get-tag-commit-alist (repo)
- "Get REPO's tag list and associate them to commit hashes."
- (require 'json)
- (mapcar
- (lambda (x)
- (cons
- (cdr (assoc 'sha (cdr (assoc 'commit x))))
- (cdr (assoc 'name x))))
- (let ((json-array-type 'list))
- (paradox--github-action
- (format "repos/%s/tags?per_page=100" repo)
- :reader #'json-read
- :max-pages paradox-commit-list-query-max-pages))))
-
-(defun paradox--get-installed-version (pkg)
- "Return the installed version of PKG.
-- If PKG isn't installed, return '(0).
-- If it has a Melpa-like version (YYYYMMDD HHMM), return it as a
- time value.
-- If it has a regular version number, return it as a string."
- (let ((desc (cadr (assoc pkg package-alist))))
- (if desc
- (let ((version (package-desc-version desc)))
- (if (> (car version) 19000000)
- (date-to-time
- (format "%8dT%02d:%02d"
- (car version)
- (/ (cadr version) 100)
- (% (cadr version) 100)))
- ;; Regular version numbers.
- (mapconcat 'int-to-string version ".")))
- '(0 0))))
-
-(defun paradox--commit-tabulated-list (repo)
- "Return the tabulated list for REPO's commit list."
- (require 'json)
- (let* ((paradox--commit-message-face nil)
- (json-array-type 'list)
- (feed (paradox--github-action
- (format "repos/%s/commits?per_page=100" repo)
- :reader #'json-read
- :max-pages paradox-commit-list-query-max-pages)))
- (apply 'append (mapcar 'paradox--commit-print-info feed))))
-
-(defun paradox--commit-print-info (x)
- "Parse json in X into a tabulated list entry."
- (let* ((commit (cdr (assoc 'commit x)))
- (date (date-to-time (cdr (assoc 'date (cdr (assoc 'committer commit))))))
- (title (split-string (cdr (assoc 'message commit)) "[\n\r][ \t]*" t))
- ;; (url (cdr (assoc 'html_url commit)))
- (cc (cdr (assoc 'comment_count commit)))
- (sha (cdr (assoc 'sha x)))
- (tag (cdr (assoc-string sha paradox--package-tag-commit-alist))))
- ;; Have we already crossed the installed commit, or is it not even installed?
- (unless (or paradox--commit-message-face
- (equal '(0) paradox--package-version))
- ;; Is this where we cross to old commits?
- (when (paradox--version<= date tag)
- (setq paradox--commit-message-face 'paradox-comment-face)))
- ;; Return the tabulated list entry.
- (cons
- ;; The ID
- (list `((is-old . ,(null paradox--commit-message-face))
- (lisp-date . ,date)
- ,@x)
- ;; The actual displayed data
- (vector
- (propertize (format-time-string paradox-date-format date)
- 'button t
- 'follow-link t
- 'action 'paradox-commit-list-visit-commit
- 'face (or paradox--commit-message-face 'link))
- (concat (if (> cc 0)
- (propertize (format "(%s comments) " cc)
- 'face 'font-lock-function-name-face)
- "")
- (if (stringp tag)
- (propertize tag 'face 'paradox-commit-tag-face)
- "")
- (if (stringp tag) " " "")
- (propertize (or (car-safe title) "")
- 'face paradox--commit-message-face))))
- (mapcar (lambda (m) (list x (vector "" (propertize m 'face paradox--commit-message-face))))
- (cdr title)))))
-
-(defun paradox--version<= (date version)
- "Non-nil if commit at DATE tagged with VERSION is older or equal to `paradox--package-version'."
- ;; Melpa date-like versions
- (if (listp paradox--package-version)
- ;; Installed date >= to commit date
- (null (time-less-p paradox--package-version date))
- ;; Regular version numbers.
- (and version
- (ignore-errors (version<= version paradox--package-version)))))
-
-(defun paradox--commit-list-update-entries ()
- "Update entries of current commit-list."
- (setq tabulated-list-entries
- (paradox--commit-tabulated-list paradox--package-repo)))
-
-\f
-;;; Commands
-(defun paradox-commit-list-visit-commit (&optional _)
- "Visit this commit on GitHub.
-IGNORE is ignored."
- (interactive)
- (when (derived-mode-p 'paradox-commit-list-mode)
- (browse-url (cdr (assoc 'html_url (tabulated-list-get-id))))))
-
-(defun paradox-previous-commit (&optional n)
- "Move to previous commit, which might not be the previous line.
-With prefix N, move to the N-th previous commit."
- (interactive "p")
- (paradox-next-commit (- n)))
-
-(defun paradox-next-commit (&optional n)
- "Move to next commit, which might not be the next line.
-With prefix N, move to the N-th next commit."
- (interactive "p")
- (dotimes (_ (abs n))
- (let ((d (cl-signum n)))
- (forward-line d)
- (while (looking-at " +")
- (forward-line d)))))
-
-\f
-;;; Mode definition
-(define-derived-mode paradox-commit-list-mode
- tabulated-list-mode "Paradox Commit List"
- "Major mode for browsing a list of commits.
-Letters do not insert themselves; instead, they are commands.
-\\<paradox-commit-list-mode-map>
-\\{paradox-commit-list-mode-map}"
- (hl-line-mode 1)
- (setq tabulated-list-format
- `[("Date" ,(length (format-time-string paradox-date-format (current-time))) nil)
- ("Message" 0 nil)])
- (setq tabulated-list-padding 1)
- (setq tabulated-list-sort-key nil)
- (add-hook 'tabulated-list-revert-hook 'paradox--commit-list-update-entries nil t)
- (tabulated-list-init-header))
-
-(define-key paradox-commit-list-mode-map "\r" #'paradox-commit-list-visit-commit)
-(define-key paradox-commit-list-mode-map "p" #'paradox-previous-commit)
-(define-key paradox-commit-list-mode-map "n" #'paradox-next-commit)
-
-
-(provide 'paradox-commit-list)
-;;; paradox-commit-list.el ends here.
+++ /dev/null
-;;; paradox-core.el --- common functions -*- lexical-binding:t -*-
-
-;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-;; Prefix: paradox
-;; Separator: -
-
-;;; License:
-;;
-;; This file is NOT part of GNU Emacs.
-;;
-;; 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 2
-;; 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.
-;;
-
-;;; Code:
-(require 'subr-x)
-
-\f
-;;; Configurations
-(defface paradox-comment-face
- '((((background light)) :foreground "Grey30")
- (((background dark)) :foreground "Grey60"))
- "Face used on faded out stuff."
- :group 'paradox-menu
- :group 'paradox-commit-list)
-(defface paradox-highlight-face
- '((t :weight bold :inherit font-lock-variable-name-face))
- "Face used on highlighted stuff."
- :group 'paradox-menu
- :group 'paradox-commit-list)
-
-\f
-;;; Internal variables
-(defvar paradox--star-count (make-hash-table))
-(defvar paradox--download-count (make-hash-table))
-(defvar paradox--package-repo-list (make-hash-table))
-(defvar paradox--wiki-packages (make-hash-table))
-
-(defconst paradox--data-url
- "https://raw.githubusercontent.com/Malabarba/paradox/data/"
- "Address of Paradox's data directory.")
-
-(defconst paradox--star-count-url (concat paradox--data-url "data-hashtables")
- "Address of the raw star-count file.")
-(make-obsolete-variable 'paradox--star-count-url 'paradox--data-url "2.1")
-
-(defconst paradox--package-count
- '(("total" . 0) ("built-in" . 0)
- ("obsolete" . 0) ("deleted" . 0)
- ("available" . 0) ("new" . 0)
- ("held" . 0) ("disabled" . 0)
- ("dependency" . 0) ("avail-obso" . 0)
- ("incompat" . 0) ("external" . 0)
- ("installed" . 0) ("unsigned" . 0)))
-
-(defmacro paradox--cas (string)
- "Same as (cdr (assoc-string ,STRING paradox--package-count))."
- `(cdr (assoc-string ,string paradox--package-count)))
-
-(defun paradox--truncate-string-to-width-filter (args)
- "Filter the args of `truncate-string-to-width' to use \"…\".
-All arguments STR, END-COLUMN, START-COLUMN, PADDING, and
-ELLIPSIS are passed to `truncate-string-to-width'."
- (when (and (eq major-mode 'paradox-menu-mode)
- (eq t (nth 4 args)))
- (setf (nth 4 args) (if (char-displayable-p ?…) "…" "$")))
- args)
-
-\f
-;;; Overriding definitions
-(defvar paradox--backups nil)
-
-(defun paradox--core-enable ()
- "Enable core features."
- (ignore-errors (setcdr (assq 'menu-bar package-menu-mode-map) nil))
- (advice-add #'truncate-string-to-width :filter-args
- #'paradox--truncate-string-to-width-filter
- '((name . :paradox-override)))
- (add-to-list 'paradox--backups 'truncate-string-to-width))
-
-(defun paradox-disable ()
- "Disable paradox, and go back to regular package-menu."
- (interactive)
- (when paradox--backups
- (message "Restoring %s" (mapconcat #'symbol-name paradox--backups ", "))
- (dolist (it paradox--backups)
- (advice-remove it :paradox-override))
- (setq paradox--backups nil)))
-
-(defun paradox--override-definition (sym newdef)
- "Temporarily override SYM's function definition with NEWDEF.
-Record that in `paradox--backups', but do nothing if
-`paradox--backups' reports that it is already overriden."
- (unless (memq sym paradox--backups)
- (message "Overriding %s with %s" sym newdef)
- (advice-add sym :override newdef '((name . :paradox-override)))
- (add-to-list 'paradox--backups sym)))
-
-\f
-;;; Pre 25.1 support
-(declare-function paradox--update-downloads-in-progress "paradox-menu")
-(if (fboundp 'package--update-downloads-in-progress)
- (defun paradox--update-downloads-in-progress (&optional name)
- (when name
- (package--update-downloads-in-progress name)))
- (defalias 'paradox--update-downloads-in-progress #'ignore))
-(define-obsolete-function-alias
- 'paradox--pdate-downloads-in-progress
- 'paradox--update-downloads-in-progress
- "2.1")
-
-\f
-;;; Spinner
-(defvar paradox--spinner nil)
-
-(eval-and-compile (require 'spinner))
-(defcustom paradox-spinner-type 'horizontal-moving
- "Holds the type of spinner to be used in the mode-line.
-Takes a value accepted by `spinner-start'."
- :type `(choice (choice :tag "Choose a spinner by name"
- ,@(mapcar (lambda (c) (list 'const (car c)))
- spinner-types))
- (const :tag "A random spinner" random)
- (repeat :tag "A list of symbols from `spinner-types' to randomly choose from"
- (choice :tag "Choose a spinner by name"
- ,@(mapcar (lambda (c) (list 'const (car c)))
- spinner-types)))
- (vector :tag "A user defined vector"
- (repeat :inline t string)))
- :package-version '(paradox . "2.1")
- :group 'paradox-execute)
-
-(defun paradox--start-spinner ()
- (when (spinner-p paradox--spinner)
- (spinner-stop paradox--spinner))
- (setq paradox--spinner
- (make-spinner paradox-spinner-type t 10))
- (spinner-start paradox--spinner))
-
-(defun paradox--stop-spinner ()
- (when (spinner-p paradox--spinner)
- (spinner-stop paradox--spinner))
- (setq paradox--spinner nil))
-
-(provide 'paradox-core)
-;;; paradox-core.el ends here.
+++ /dev/null
-;;; paradox-execute.el --- executing package transactions -*- lexical-binding:t -*-
-
-;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-;; Prefix: paradox
-;; Separator: -
-
-;;; License:
-;;
-;; This file is NOT part of GNU Emacs.
-;;
-;; 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 2
-;; 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.
-;;
-
-;;; Commentary:
-;;
-;; Functions related to executing package-menu transactions.
-;; Everything that happens when you hit `x' is in here.
-
-\f
-;;; Code:
-(require 'cl-lib)
-(require 'seq)
-
-(require 'package)
-(require 'paradox-core)
-(require 'paradox-github)
-
-(defgroup paradox-execute nil
- "Paradox Packages Menu configurations."
- :prefix "paradox-"
- :package-version '(paradox . "2.0")
- :group 'paradox)
-
-(defvar paradox--current-filter)
-\f
-;;; Customization Variables
-(defcustom paradox-execute-asynchronously 'ask
- "Whether the install/delete/upgrade should be asynchronous.
-Possible values are:
- t, which means always;
- nil, which means never;
- ask, which means ask each time."
- :type '(choice (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "Ask each time" ask))
- :package-version '(paradox . "2.0")
- :group 'paradox-execute)
-
-(defcustom paradox-async-display-buffer-function #'display-buffer
- "Function used to display *Paradox Report* buffer after asynchronous upgrade.
-Set this to nil to avoid displaying the buffer. Or set this to a
-function like `display-buffer' or `pop-to-buffer'.
-
-This is only used if `paradox-menu-execute' was given a non-nil
-NOQUERY argument. Otherwise, only a message is displayed."
- :type '(choice (const :tag "Don't display the buffer" nil)
- function)
- :package-version '(paradox . "2.0")
- :group 'paradox-execute)
-
-\f
-;;; Execution Hook
-(defvar paradox-after-execute-functions nil
- "List of functions run after performing package transactions.
-These are run after a set of installation, deletion, or upgrades
-has been performed. Each function in this hook must take a single
-argument. An associative list of the form
-
- ((SYMBOL . DATA) (SYMBOL . DATA) ...)
-
-This list contains the following entries, describing what
-occurred during the execution:
-
- SYMBOL DATA
- `installed' List of installed packages.
- `deleted' List of deleted packages.
- `activated' List of activated packages.
- `error' List of errors.
- `async' Non-nil if transaction was performed asynchronously.
- `noquery' The NOQUERY argument given to `paradox-menu-execute'.")
-(put 'risky-local-variable-p 'paradox-after-execute-functions t)
-(mapc (lambda (x) (add-hook 'paradox-after-execute-functions x t))
- '(paradox--activate-if-asynchronous
- paradox--refresh-package-buffer
- paradox--report-buffer-print
- paradox--report-buffer-display-if-noquery
- paradox--report-message
- ))
-
-(defun paradox--refresh-package-buffer (_)
- "Refresh the *Packages* buffer, if it exists."
- (let ((buf (get-buffer "*Packages*")))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (revert-buffer)))))
-
-(defun paradox--activate-if-asynchronous (alist)
- "Activate packages after an asynchronous operation.
-Argument ALIST describes the operation."
- (let-alist alist
- (when .async
- (dolist (pkg .activated)
- (if (fboundp 'package--list-loaded-files)
- (package-activate-1 pkg 'reload)
- (package-activate-1 pkg))))))
-
-(defun paradox--print-package-list (list)
- "Print LIST at point."
- (let* ((width (apply #'max
- (mapcar (lambda (x) (string-width (symbol-name (package-desc-name x))))
- list)))
- (tabulated-list-format
- `[("Package" ,(1+ width) nil)
- ("Version" 0 nil)])
- (tabulated-list-padding 2))
- (mapc
- (lambda (p) (tabulated-list-print-entry
- p
- `[,(symbol-name (package-desc-name p))
- ,(package-version-join (package-desc-version p))]))
- list)))
-
-(defun paradox--report-buffer-print (alist)
- "Print a transaction report in *Package Report* buffer.
-Possibly display the buffer or message the user depending on the
-situation.
-Argument ALIST describes the operation."
- (let-alist alist
- (let ((buf (get-buffer-create "*Paradox Report*"))
- (inhibit-read-only t))
- (with-current-buffer buf
- (goto-char (point-max))
- ;; TODO: Write our own mode for this.
- (special-mode)
- (insert "\n\f\n")
- (save-excursion
- (insert (format-time-string "Package transaction finished. %c\n"))
- (when .error
- (insert "Errors:\n ")
- (dolist (it .error)
- (princ it (current-buffer))
- (insert "\n"))
- (insert "\n\n"))
- (when .installed
- (insert "Installed:\n")
- (paradox--print-package-list .installed)
- (insert "\n"))
- (when .deleted
- (insert "Deleted:\n")
- (paradox--print-package-list .deleted)
- (insert "\n")))))))
-
-(defun paradox--report-buffer-display-if-noquery (alist)
- "Display report buffer if `paradox-execute' was called with a NOQUERY prefix.
-ALIST describes the transaction.
-`paradox-async-display-buffer-function' is used if transaction
-was asynchronous. Otherwise, `pop-to-buffer' is used."
- (let-alist alist
- ;; The user has never seen the packages in this transaction. So
- ;; we display them in a buffer.
- (when (or .noquery .error)
- (let ((buf (get-buffer "*Paradox Report*")))
- (when (buffer-live-p buf)
- (cond
- ;; If we're async, the user might be doing something else, so
- ;; we don't steal focus.
- ((and .async paradox-async-display-buffer-function)
- (funcall paradox-async-display-buffer-function buf))
- ;; If we're not async, just go ahead and pop.
- ((or (not .async)
- ;; If there's an error, display the buffer even if
- ;; `paradox-async-display-buffer-function' is nil.
- .error)
- (pop-to-buffer buf))))))))
-
-(defun paradox--report-message (alist)
- "Message the user about the executed transaction.
-ALIST describes the transaction."
- (let-alist alist
- (message "%s%s"
- (paradox--format-message nil .installed .deleted)
- (if (memq 'paradox--report-buffer-print paradox-after-execute-functions)
- " See the buffer *Paradox Report* for more details." ""))
- (when .errors
- (message "Errors encountered during the operation: %S\n%s"
- .errors
- (if (memq 'paradox--report-buffer-print paradox-after-execute-functions)
- " See the buffer *Paradox Report* for more details." "")))))
-
-\f
-;;; Execution
-(defun paradox-menu-execute (&optional noquery)
- "Perform marked Package Menu actions.
-Packages marked for installation are downloaded and installed;
-packages marked for deletion are removed.
-
-Afterwards, if `paradox-automatically-star' is t, automatically
-star new packages, and unstar removed packages. Upgraded packages
-aren't changed.
-
-Synchronicity of the actions depends on
-`paradox-execute-asynchronously'. Optional argument NOQUERY
-non-nil means do not ask the user to confirm. If asynchronous,
-never ask anyway."
- (interactive "P")
- (unless (derived-mode-p 'paradox-menu-mode)
- (error "The current buffer is not in Paradox Menu mode"))
- (when (and (stringp paradox-github-token)
- (eq paradox-automatically-star 'unconfigured))
- (customize-save-variable
- 'paradox-automatically-star
- (y-or-n-p "When you install new packages would you like them to be automatically starred?
-\(They will be unstarred when you delete them) ")))
- (when (and (stringp paradox--current-filter)
- (string-match "Upgradable" paradox--current-filter))
- (setq tabulated-list-sort-key '("Status" . nil))
- (setq paradox--current-filter nil))
- (paradox--menu-execute-1 noquery))
-
-(defmacro paradox--perform-package-transaction (install delete)
- "Install all packages from INSTALL and delete those from DELETE.
-Return an alist with properties listing installed,
-deleted, and activated packages, and errors."
- `(let (activated installed deleted errored)
- (advice-add #'package-activate-1 :after
- (lambda (pkg &rest _)
- (ignore-errors (push pkg activated)))
- '((name . paradox--track-activated)))
- (condition-case err
- (progn
- (dolist (pkg ,install)
- ;; 2nd arg introduced in 25.
- (if (version<= "25" emacs-version)
- (package-install pkg 'dont-select)
- (package-install pkg))
- (push pkg installed))
- (let ((delete-list ,delete))
- (dolist (pkg (if (fboundp 'package--sort-by-dependence)
- (package--sort-by-dependence delete-list)
- delete-list))
- (condition-case err
- (progn (package-delete pkg)
- (push pkg deleted))
- (error (push err errored))))))
- (error (push err errored)))
- (advice-remove #'package-activate-1 'paradox--track-activated)
- (list (cons 'installed (nreverse installed))
- (cons 'deleted (nreverse deleted))
- (cons 'activated (nreverse activated))
- (cons 'error (nreverse errored)))))
-
-(defvar paradox--current-filter)
-
-(declare-function async-inject-variables "async")
-(defun paradox--menu-execute-1 (&optional noquery)
- "Implementation used by `paradox-menu-execute'.
-NOQUERY, if non-nil, means to execute without prompting the
-user."
- (let ((before-alist (paradox--repo-alist))
- install-list delete-list)
- (save-excursion
- (goto-char (point-min))
- (let ((p (point))
- (inhibit-read-only t))
- (while (not (eobp))
- (let ((c (char-after)))
- (if (eq c ?\s)
- (forward-line 1)
- (push (tabulated-list-get-id)
- (pcase c
- (`?D delete-list)
- (`?I install-list)))
- (delete-region p (point))
- (forward-line 1)
- (setq p (point)))))
- (when (or delete-list install-list)
- (delete-region p (point))
- (ignore-errors
- (set-window-start (selected-window) (point-min))))))
- (if (not (or delete-list install-list))
- (message "No operations specified.")
- ;; Confirm with the user.
- (when (or noquery
- (y-or-n-p (paradox--format-message 'question install-list delete-list)))
- ;; On Emacs 25, update the selected packages list.
- (when (fboundp 'package--update-selected-packages)
- (let-alist (package-menu--partition-transaction install-list delete-list)
- (package--update-selected-packages .install .delete)))
- ;; Background or foreground?
- (if (or (not install-list)
- (not (pcase paradox-execute-asynchronously
- (`nil nil)
- (`ask
- (if noquery nil
- (y-or-n-p "Execute in the background (see `paradox-execute-asynchronously')? ")))
- (_ t))))
- ;; Synchronous execution
- (progn
- (let ((alist (paradox--perform-package-transaction install-list delete-list)))
- (run-hook-with-args 'paradox-after-execute-functions
- `((noquery . ,noquery) (async . nil) ,@alist)))
- (when (and (stringp paradox-github-token) paradox-automatically-star)
- (paradox--post-execute-star-unstar before-alist (paradox--repo-alist))))
- ;; Start spinning
- (paradox--start-spinner)
-
- ;; Async execution
- (unless (require 'async nil t)
- (error "For asynchronous execution please install the `async' package"))
- ;; We have to do this with eval, because `async-start' is a
- ;; macro and it might not have been defined at compile-time.
- (eval
- `(async-start
- (lambda ()
- (require 'package)
- ,(async-inject-variables "\\`package-")
- (setq package-menu-async nil)
- (dolist (elt package-alist)
- (package-activate (car elt) 'force))
- (let ((alist ,(macroexpand
- `(paradox--perform-package-transaction ',install-list ',delete-list))))
- (list package-alist
- (when (boundp 'package-selected-packages)
- package-selected-packages)
- package-archive-contents
- ;; This is the alist that will be passed to the hook.
- (cons '(noquery . ,noquery) (cons '(async . t) alist)))))
- (lambda (x)
- (setq package-alist (pop x)
- package-selected-packages (pop x)
- package-archive-contents (pop x))
- (when (spinner-p paradox--spinner)
- (spinner-stop paradox--spinner)
- (setq paradox--spinner nil))
- (setq paradox--executing nil)
- (run-hook-with-args 'paradox-after-execute-functions (pop x))
- (paradox--post-execute-star-unstar ',before-alist (paradox--repo-alist))))))))))
-
-\f
-;;; Aux functions
-(defun paradox--repo-alist ()
- "List of known repos."
- (delete-dups
- (remove nil
- (mapcar
- (lambda (it) (gethash it paradox--package-repo-list))
- package-alist))))
-
-(defun paradox--format-message (question-p install-list delete-list)
- "Format a message regarding a transaction.
-If QUESTION-P is non-nil, format a question suitable for
-`y-or-n-p', otherwise format a report in the past sense.
-INSTALL-LIST and DELETE-LIST are a list of packages about to be
-installed and deleted, respectively."
- (concat
- (when install-list
- (let ((len (length install-list)))
- (format "Install%s %d package%s"
- (if question-p "" "ed")
- len
- (if (> len 1) "s" ""))))
- (when (and install-list (not delete-list))
- (if question-p "? " "."))
- (when (and install-list delete-list)
- ", and ")
- (when delete-list
- (let ((len (length delete-list)))
- (format "Delete%s %d package%s%s"
- (if question-p "" "d")
- len
- (if (> len 1) "s" "")
- (if question-p "? " "."))))))
-
-(defun paradox--post-execute-star-unstar (before after)
- "Star repos in AFTER absent from BEFORE, unstar vice-versa."
- (let ((repos (hash-table-keys paradox--user-starred-repos)))
- (mapc #'paradox--star-repo
- (seq-difference (seq-difference after before) repos))
- (mapc #'paradox--unstar-repo
- (seq-intersection (seq-difference before after) repos))))
-
-(provide 'paradox-execute)
-;;; paradox-execute.el ends here
+++ /dev/null
-;;; paradox-github.el --- interacting with the Github API -*- lexical-binding:t -*-
-
-;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-;; Prefix: paradox
-;; Separator: -
-
-;;; License:
-;;
-;; This file is NOT part of GNU Emacs.
-;;
-;; 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 2
-;; 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.
-;;
-
-\f
-;;; Code:
-(require 'cl-lib)
-(require 'package)
-(require 'paradox-core)
-
-(defgroup paradox-github nil
- "Paradox Github configurations."
- :prefix "paradox-"
- :package-version '(paradox . "2.0")
- :group 'paradox)
-
-(defvar paradox--user-starred-list nil)
-(make-obsolete-variable
- 'paradox--user-starred-list 'paradox--user-starred-repos "2.1")
-(defvar paradox--user-starred-repos (make-hash-table))
-
-\f
-;;; Github token
-(defcustom paradox-github-token nil
- "Access token to use for github actions.
-Currently, that means (un)starring repos.
-
-To generate an access token:
- 1. Visit the page https://github.com/settings/tokens/new?scopes=public_repo&description=Paradox
- and login to github (if asked).
- 2. Click on \"Generate Token\", copy the generated token, and
- save it to this variable by writing
- (setq paradox-github-token TOKEN)
- somewhere in your configuration and evaluating it (or just
- restart emacs).
-
-This is similar to how erc or jabber handle authentication in
-emacs, but the following disclaimer always worth reminding.
-
-DISCLAIMER
-When you save this variable, DON'T WRITE IT ANYWHERE PUBLIC. This
-token grants (very) limited access to your account.
-END DISCLAIMER
-
-One way to make this variable safer is to set it from your
-authinfo.gpg file. See this issue for instructions on how to do that:
-https://github.com/Malabarba/paradox/issues/147#issuecomment-409336111
-
-Paradox will ask you whether you want github integration the
-first time you start it. If you answer \"no\", it will remember
-your choice via `customize-save-variable'. You can do this
-manually by setting this variable to t. Setting it to nil means
-it hasn't been configured yet."
- :type '(choice (string :tag "Token")
- (const :tag "Disable" t)
- (const :tag "Ask me next time" nil))
- :group 'paradox-github
- :package-version '(paradox . "0.2"))
-
-(defcustom paradox-automatically-star 'unconfigured
- "When you install new packages, should they be automatically starred?
-This variable has no effect if `paradox-github-token' isn't set
-to a string.
-
-Paradox is capable of automatically starring packages when you
-install them, and unstarring when you delete them. This only
-applies to actual installation/deletion, i.e. Paradox doesn't
-auto (un)star packages that were simply upgraded.
-
-If this variable is nil, this behaviour is disabled. \\<paradox-menu-mode-map>
-
-On the Package Menu, you can always manually star packages with \\[paradox-menu-mark-star-unstar]."
- :type '(choice (const :tag "Yes" t)
- (const :tag "No" nil)
- (const :tag "Ask later" unconfigured))
- :group 'paradox-github
- :package-version '(paradox . "0.2"))
-
-(defmacro paradox--enforce-github-token (&rest forms)
- "If a token is defined, perform FORMS, otherwise ignore forms ask for it be defined."
- `(if (stringp paradox-github-token)
- (progn ,@forms)
- (setq paradox-github-token nil)
- (paradox--check-github-token)))
-
-(defun paradox--check-github-token ()
- "Check that the user has either set or refused the github token.
-If neither has happened, ask the user now whether he'd like to
-configure or refuse the token."
- (if (stringp paradox-github-token) t
- (if paradox-github-token
- t
- (if (not (y-or-n-p "Would you like to set up GitHub integration?
-This will allow you to star/unstar packages from the Package Menu. "))
- (customize-save-variable 'paradox-github-token t)
- (describe-variable 'paradox-github-token)
- (when (get-buffer "*Help*")
- (switch-to-buffer "*Help*")
- (delete-other-windows))
- (if (y-or-n-p "Follow the instructions on the `paradox-github-token' variable.
-May I take you to the token generation page? ")
- (browse-url "https://github.com/settings/tokens/new?scopes=public_repo&description=Paradox"))
- (message "Once you're finished, simply call `paradox-list-packages' again.")
- nil))))
-
-\f
-;;; Starring
-(defun paradox-star-all-installed-packages ()
- "Star all of your currently installed packages.
-No questions asked."
- (interactive)
- (paradox--enforce-github-token
- (mapc (lambda (x) (paradox--star-package-safe (car-safe x))) package-alist)))
-
-(defun paradox--starred-repo-p (repo)
- "Non-nil if REPO is starred by the user."
- (gethash repo paradox--user-starred-repos))
-
-(defun paradox--star-package-safe (pkg &optional delete query)
- "Star PKG without throwing errors, unless DELETE is non-nil, then unstar.
-If QUERY is non-nil, ask the user first."
- (let ((repo (gethash pkg paradox--package-repo-list)))
- (when (and repo (paradox--starred-repo-p repo))
- (paradox--star-repo repo delete query))))
-
-(defun paradox--star-repo (repo &optional delete query)
- "Star REPO, unless DELETE is non-nil, then unstar.
-If QUERY is non-nil, ask the user first.
-
-Throws error if repo is malformed."
- (when (or (not query)
- (y-or-n-p (format "Really %sstar %s? "
- (if delete "un" "") repo)))
- (paradox--github-action-star repo delete)
- (message "%starred %s." (if delete "Uns" "S") repo)
- (if delete
- (remhash repo paradox--user-starred-repos)
- (puthash repo t paradox--user-starred-repos))))
-
-(defun paradox--unstar-repo (repo &optional delete query)
- "Unstar REPO.
-Calls (paradox--star-repo REPO (not DELETE) QUERY)."
- (paradox--star-repo repo (not delete) query))
-
-(defun paradox--full-name-reader ()
- "Return all \"full_name\" properties in the buffer.
-Much faster than `json-read'."
- (let (out)
- (while (search-forward-regexp
- "^ *\"full_name\" *: *\"\\(.*\\)\", *$" nil t)
- (push (match-string-no-properties 1) out))
- (goto-char (point-max))
- out))
-
-(defun paradox--refresh-user-starred-list (&optional async)
- "Fetch the user's list of starred repos."
- (paradox--github-action "user/starred?per_page=100"
- :async (when async 'refresh)
- :callback (lambda (res)
- (setq paradox--user-starred-repos
- (make-hash-table :size (length res)
- :test #'equal))
- (dolist (it res)
- (puthash it t paradox--user-starred-repos)))
- :reader #'paradox--full-name-reader))
-
-(defun paradox--github-action-star (repo &optional delete)
- "Call `paradox--github-action' with \"user/starred/REPO\" as the action.
-DELETE and NO-RESULT are passed on."
- (paradox--github-action (concat "user/starred/" repo)
- :async t
- :method (if (stringp delete) delete
- (if delete "DELETE" "PUT"))))
-
-\f
-;;; The Base (generic) function
-(defun paradox--github-report (&rest text)
- "Write TEXT to the *Paradox Github* buffer."
- (with-current-buffer (get-buffer-create "*Paradox Report*")
- (let ((inhibit-read-only t))
- (erase-buffer)
- (apply #'insert text))
- (goto-char (point-min))))
-
-(defun paradox--github-error (format &rest args)
- "Throw an error using FORMAT and ARGS.
-Also print contents of current buffer to *Paradox Github*."
- (declare (indent 1))
- (paradox--github-report (buffer-string))
- (apply #'error
- (concat format " See *Paradox Github* buffer for the full result")
- args))
-
-(defvar paradox--github-errors-to-ignore nil
- "List of numbers to ignore when parsing the HTML return code.
-`paradox--github-parse-response-code' normally returns nil on
-200, t on 204, and emits messages or errors on other values.
-Adding values to this list makes them be treated as a 200.")
-
-(defun paradox--github-parse-response-code ()
- "Non-nil if this reponse buffer looks ok.
-Leave point at the return code on the first line."
- (goto-char (point-min))
- (unless (search-forward " " nil t)
- (paradox--github-report (buffer-string))
- (error "Tried contacting Github, but I can't understand the result. See *Paradox Github* buffer for the full result"))
- (pcase (thing-at-point 'number)
- ((pred (lambda (n) (member n paradox--github-errors-to-ignore))) nil)
- (`204 nil) ;; OK, but no content.
- (`200 t) ;; OK, with content.
- ;; I'll implement redirection if anyone ever reports this.
- ;; For now, I haven't found a place where it's used.
- ((or `301 `302 `303 `304 `305 `306 `307)
- (paradox--github-report "Redirect received:\n\n" (buffer-string))
- ;; (message "Received a redirect reply, please file a bug report (M-x `paradox-bug-report')")
- nil)
- ((or `404) ;; Not found.
- (paradox--github-report (buffer-string))
- (message "This repo doesn't seem to exist, Github replied with: %s"
- (substring (thing-at-point 'line) 0 -1))
- nil)
- ((or `403) ;; Forbidden
- (paradox--github-error
- "Github wouldn't let me do this - does your token have the right permissions? They're here: https://github.com/settings/tokens"))
- ((or `400 `422) ;; Bad request.
- (paradox--github-error
- "Github didn't understand my request, please file a bug report (M-x `paradox-bug-report')"))
- (`401 (paradox--github-error
- (if (stringp paradox-github-token)
- "Github says you're not authenticated, try creating a new Github token"
- "Github says you're not authenticated, you need to configure `paradox-github-token'")))
- (_ (paradox--github-error "Github returned: %S"
- (substring (thing-at-point 'line) 0 -1)))))
-
-(defvar paradox--github-next-page nil)
-
-(defmacro paradox--with-github-buffer (method action async unwind-form
- &rest body)
- "Run BODY in a Github request buffer.
-UNWIND-FORM is run no matter what, and doesn't affect the return
-value."
- (declare (indent 4)
- (debug t))
- (let ((call-name (make-symbol "callback")))
- `(let ((,call-name
- (lambda (&optional process event)
- (cond
- ((or (not event)
- (string-match "\\`finished" event))
- (with-current-buffer (if (processp process)
- (process-buffer process)
- (current-buffer))
- (unwind-protect
- (when (paradox--github-parse-response-code)
- (let ((next-page))
- (when (search-forward-regexp
- "^Link: .*<\\([^>]+\\)>; rel=\"next\"" nil t)
- (setq next-page (match-string-no-properties 1))
- (setq paradox--github-next-page next-page))
- (ignore next-page)
- (search-forward-regexp "^\r?$")
- (skip-chars-forward "[:blank:]\n\r")
- (delete-region (point-min) (point))
- ,@body))
- ,unwind-form
- (kill-buffer (current-buffer)))))
- ((string-match "\\`exited abnormally" event)
- ,unwind-form
- (paradox--github-report (buffer-string))
- (message "async curl command %s\n method: %s\n action: %s"
- event ,method ,action))))))
- (if ,async
- (condition-case nil
- (set-process-sentinel
- (apply #'start-process "paradox-github"
- (generate-new-buffer "*Paradox http*")
- "curl" "-s" "-i" "-d" "" "-X" ,method ,action
- (when (stringp paradox-github-token)
- (list "-u" (concat paradox-github-token ":x-oauth-basic"))))
- ,call-name)
- (error ,unwind-form))
- (with-temp-buffer
- ;; Make the request.
- (condition-case nil
- (apply #'call-process
- "curl" nil t nil "-s" "-i" "-d" "" "-X" ,method ,action
- (when (stringp paradox-github-token)
- (list "-u" (concat paradox-github-token ":x-oauth-basic"))))
- (error ,unwind-form))
- ;; Do the processing.
- (funcall ,call-name))))))
-
-(cl-defun paradox--github-action (action &key
- (method "GET")
- reader
- max-pages
- (callback #'identity)
- async)
- "Contact the github api performing ACTION with METHOD.
-Default METHOD is \"GET\".
-
-Action can be anything such as \"user/starred?per_page=100\". If
-it's not a full url, it will be prepended with
-\"https://api.github.com/\". The action might not work if
-`paradox-github-token' isn't set.
-
-This function also handles the pagination used in github results,
-results of each page are appended together. Use MAX-PAGES to
-limit the number of pages that are fetched.
-
-Return value is always a list.
-- If READER is nil, the result of the action is completely
- ignored (no pagination is performed on this case, making it
- much faster).
-- Otherwise, READER is called as a function with point right
- after the headers and should always return a list. As a special
- exception, if READER is t, it is equivalent to a function that
- returns (t).
-
-CALLBACK, if provided, is a function to be called with the read
-data as an argument. If the request succeeds with no data, it
-will be given nil as an argument. Its return value is returned by
-this function.
-
-ASYNC determines to run the command asynchronously. In this case,
-the function's return value is undefined. In particular, if ASYNC
-is the symbol refresh, it means the package-menu should be
-refreshed after the operation is done."
- (declare (indent 1))
- ;; Make sure the token's configured.
- (unless (string-match "\\`https?://" action)
- (setq action (concat "https://api.github.com/" action)))
- (let ((do-update (when (eq async 'refresh)
- (make-symbol "paradox-github"))))
- (when do-update
- (add-to-list 'package--downloads-in-progress do-update))
- (paradox--with-github-buffer method action async
- (paradox--update-downloads-in-progress
- do-update)
- (cond
- ((not reader)
- (funcall callback nil))
- ((or (not next-page)
- (and max-pages (< max-pages 2)))
- (funcall callback
- (unless (eobp) (funcall reader))))
- (t
- (let ((result (unless (eobp) (funcall reader))))
- (paradox--github-action next-page
- :method method
- :reader reader
- :async async
- :max-pages (when max-pages (1- max-pages))
- :callback (lambda (res)
- (funcall callback
- (append result res))))))))))
-
-(provide 'paradox-github)
-;;; paradox-github.el ends here
+++ /dev/null
-;;; paradox-menu.el --- defining the Packages menu -*- lexical-binding:t -*-
-
-;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-
-;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
-;; Prefix: paradox
-;; Separator: -
-
-;;; License:
-;;
-;; This file is NOT part of GNU Emacs.
-;;
-;; 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 2
-;; 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.
-;;
-
-;;; Code:
-(require 'cl-lib)
-(require 'package)
-(require 'subr-x)
-(require 'hydra)
-
-(require 'paradox-core)
-(require 'paradox-github)
-(require 'paradox-commit-list)
-(require 'paradox-execute)
-
-(defgroup paradox-menu nil
- "Paradox Packages Menu configurations."
- :prefix "paradox-"
- :package-version '(paradox . "2.0")
- :group 'paradox)
-
-\f
-;;; Customization Variables
-(defcustom paradox-column-width-package 18
- "Width of the \"Package\" column."
- :type 'integer
- :group 'paradox-menu
- :package-version '(paradox . "0.1"))
-
-(defcustom paradox-column-width-version 9
- "Width of the \"Version\" column."
- :type 'integer
- :group 'paradox-menu
- :package-version '(paradox . "0.1"))
-
-(defcustom paradox-column-width-status 10
- "Width of the \"Status\" column."
- :type 'integer
- :group 'paradox-menu
- :package-version '(paradox . "0.1"))
-
-(defcustom paradox-column-width-star 4
- "Width of the \"Star\" column."
- :type 'integer
- :group 'paradox-menu
- :package-version '(paradox . "0.1"))
-
-(defcustom paradox-column-width-download 4
- "Width of the \"Download Count\" column."
- :type 'integer
- :group 'paradox-menu
- :package-version '(paradox . "1.1"))
-
-(defcustom paradox-display-star-count t
- "If non-nil, adds a \"Star\" column to the Package Menu."
- :type 'boolean
- :group 'paradox-menu
- :package-version '(paradox . "1.1"))
-
-(defcustom paradox-display-download-count nil
- "If non-nil, adds a \"Download\" column to the Package Menu."
- :type 'boolean
- :group 'paradox-menu
- :package-version '(paradox . "1.2.3"))
-
-(defface paradox-mode-line-face
- '((t :inherit (font-lock-keyword-face mode-line-buffer-id)
- :weight normal))
- "Face used on mode line statuses."
- :group 'paradox)
-(defface paradox-name-face
- '((t :inherit link))
- "Face used on the package's name."
- :group 'paradox)
-(defface paradox-homepage-button-face
- '((t :underline t :inherit font-lock-comment-face))
- "Face used on the homepage button."
- :group 'paradox)
-;; (defface paradox-version-face
-;; '((t :inherit default))
-;; "Face used on the version column."
-;; :group 'paradox)
-(defface paradox-archive-face
- '((t :inherit paradox-comment-face))
- "Face used on the archive column."
- :group 'paradox)
-(defface paradox-star-face
- '((t :inherit font-lock-string-face))
- "Face used on the star column, for packages you haven't starred."
- :group 'paradox)
-(defface paradox-starred-face
- '((t :inherit font-lock-variable-name-face))
- "Face used on the star column, for packages you have starred."
- :group 'paradox)
-(defface paradox-download-face
- '((t :inherit font-lock-keyword-face))
- "Face used on the Downloads column."
- :group 'paradox)
-(defface paradox-description-face
- '((t :inherit default))
- "Face used on the description column.
-If `paradox-lines-per-entry' > 1, the face
-`paradox-description-face-multiline' is used instead."
- :group 'paradox)
-(defface paradox-description-face-multiline
- '((t :inherit font-lock-doc-face))
- "Face used on the description column when `paradox-lines-per-entry' > 1.
-If `paradox-lines-per-entry' = 1, the face
-`paradox-description-face' is used instead."
- :group 'paradox)
-
-(defcustom paradox-status-face-alist
- '(("built-in" . font-lock-builtin-face)
- ("available" . default)
- ("new" . bold)
- ("held" . font-lock-constant-face)
- ("disabled" . font-lock-warning-face)
- ("avail-obso" . font-lock-comment-face)
- ("installed" . font-lock-comment-face)
- ("dependency" . font-lock-comment-face)
- ("incompat" . font-lock-comment-face)
- ("deleted" . font-lock-comment-face)
- ("unsigned" . font-lock-warning-face))
- "List of (\"STATUS\" . FACE) cons cells.
-When displaying the package menu, FACE will be used to paint the
-Version, Status, and Description columns of each package whose
-status is STATUS."
- :type '(repeat (cons string face))
- :group 'paradox-menu
- :package-version '(paradox . "2.0"))
-
-(defcustom paradox-homepage-button-string "h"
- "String used to for the link that takes you to a package's homepage."
- :type 'string
- :group 'paradox-menu
- :package-version '(paradox . "0.10"))
-
-(defcustom paradox-use-homepage-buttons t
- "If non-nil a button will be added after the name of each package.
-This button takes you to the package's homepage."
- :type 'boolean
- :group 'paradox-menu
- :package-version '(paradox . "0.10"))
-
-(defcustom paradox-lines-per-entry 1
- "Number of lines used to display each entry in the Package Menu.
-1 Gives you the regular package menu.
-2 Displays the description on a separate line below the entry.
-3+ Adds empty lines separating the entries."
- :type 'integer
- :group 'paradox-menu
- :package-version '(paradox . "0.10"))
-
-\f
-;;; Internal
-(defvar-local paradox--current-filter nil)
-
-(defvar paradox--column-name-star
- (if (char-displayable-p ?\x2605) "\x2605" "*"))
-
-(defvar paradox--column-name-download
- (if (char-displayable-p ?\x2193) "\x2193" "DC"))
-
-(defvar paradox--upgradeable-packages nil)
-(defvar paradox--upgradeable-packages-number nil)
-(defvar paradox--upgradeable-packages-any? nil)
-
-(defvar paradox--column-index-star nil)
-(defvar paradox--column-index-download nil)
-
-(defvar paradox--desc-suffix nil)
-(defvar paradox--desc-prefix nil)
-
-(defvar paradox--commit-list-buffer "*Package Commit List*")
-
-\f
-;;; Building the packages buffer.
-(defun paradox-refresh-upgradeable-packages ()
- "Refresh the list of upgradeable packages."
- (interactive)
- (setq paradox--upgradeable-packages (package-menu--find-upgrades))
- (setq paradox--upgradeable-packages-number
- (length paradox--upgradeable-packages))
- (setq paradox--upgradeable-packages-any?
- (> paradox--upgradeable-packages-number 0)))
-
-(defun paradox--print-info (pkg)
- "Return a package entry suitable for `tabulated-list-entries'.
-PKG has the form (PKG-DESC . STATUS).
-Return (PKG-DESC [STAR NAME VERSION STATUS DOC])."
- (let* ((pkg-desc (if (consp pkg) (car pkg) pkg))
- (status (if (consp pkg) (cdr pkg) (package-desc-status pkg)))
- (face (or (cdr (assoc-string status paradox-status-face-alist))
- 'font-lock-warning-face))
- (url (paradox--package-homepage pkg-desc))
- (name (symbol-name (package-desc-name pkg-desc)))
- (name-length (length name))
- (counts (paradox--count-print (package-desc-name pkg-desc)))
- (button-length (if paradox-use-homepage-buttons (length paradox-homepage-button-string) 0)))
- (paradox--incf status)
- (let ((cell (assq :stars (package-desc-extras pkg-desc))))
- (if cell
- (setcdr cell counts)
- (push (cons :stars counts) (package-desc-extras pkg-desc))))
- (list pkg-desc
- `[,(concat
- (truncate-string-to-width
- (propertize name
- 'font-lock-face 'paradox-name-face
- 'button t
- 'follow-link t
- 'help-echo (format "Package: %s" name)
- 'package-desc pkg-desc
- 'action 'package-menu-describe-package)
- (- paradox-column-width-package button-length) 0 nil t)
- (when (and paradox-use-homepage-buttons url)
- (make-string (max 0 (- paradox-column-width-package name-length button-length)) ?\s))
- (when (and paradox-use-homepage-buttons url)
- (propertize paradox-homepage-button-string
- 'font-lock-face 'paradox-homepage-button-face
- 'mouse-face 'custom-button-mouse
- 'help-echo (format "Visit %s" url)
- 'button t
- 'follow-link t
- 'keymap '(keymap (mouse-2 . push-button))
- 'action #'paradox-menu-visit-homepage)))
- ,(propertize (package-version-join
- (package-desc-version pkg-desc))
- 'font-lock-face face)
- ,(propertize status 'font-lock-face face)
- ,@(if (cdr package-archives)
- (list (propertize (or (package-desc-archive pkg-desc) "")
- 'font-lock-face 'paradox-archive-face)))
- ,@counts
- ,(propertize
- (concat (propertize " " 'display paradox--desc-prefix)
- (package-desc-summary pkg-desc)
- (propertize " " 'display paradox--desc-suffix)) ;└╰
- 'font-lock-face
- (if (> paradox-lines-per-entry 1)
- 'paradox-description-face-multiline
- 'paradox-description-face))])))
-
-(defun paradox--count-print (pkg)
- "Return counts of PKG as a package-desc list."
- (append
- (when (and paradox-display-star-count (hash-table-p paradox--star-count))
- (list (paradox--package-star-count pkg)))
- (when (and paradox-display-download-count (hash-table-p paradox--download-count))
- (list (paradox--package-download-count pkg)))))
-
-(defun paradox--package-download-count (pkg)
- "Return propertized string with the download count of PKG."
- (let ((c (gethash pkg paradox--download-count nil)))
- (propertize
- (if (numberp c)
- (if (> c 999) (format "%sK" (truncate c 1000)) (format "%s" c))
- " ")
- 'font-lock-face 'paradox-download-face
- 'value (or c 0))))
-
-(defun paradox--package-homepage (pkg)
- "PKG can be the package-name symbol or a package-desc object."
- (let* ((object (if (symbolp pkg) (cadr (assoc pkg package-archive-contents)) pkg))
- (name (if (symbolp pkg) pkg (package-desc-name pkg)))
- (extras (package-desc-extras object))
- (homepage (and (listp extras) (cdr-safe (assoc :url extras)))))
- (or homepage
- (and (setq extras (gethash name paradox--package-repo-list))
- (format "https://github.com/%s" extras)))))
-
-(defun paradox--get-or-return-package (pkg)
- "Take a marker or package name PKG and return a package name."
- (if (or (markerp pkg) (null pkg))
- (if (derived-mode-p 'package-menu-mode)
- (package-desc-name (tabulated-list-get-id))
- (error "Not in Package Menu"))
- pkg))
-
-(defun paradox--incf (status)
- "Increment the count for STATUS on `paradox--package-count'.
-Also increments the count for \"total\"."
- (paradox--inc-count status)
- (unless (member status '("obsolete" "avail-obso" "incompat"))
- (paradox--inc-count "total")))
-
-(defun paradox--inc-count (string)
- "Increment the cdr of (assoc-string STRING paradox--package-count)."
- (let ((cons (assoc-string string paradox--package-count)))
- (setcdr cons (1+ (cdr cons)))))
-
-(defun paradox--entry-star-count (entry)
- "Get the star count of the package in ENTRY."
- (paradox--package-star-count
- ;; The package symbol should be in the ID field, but that's not mandatory,
- (or (ignore-errors (elt (car entry) 1))
- ;; So we also try interning the package name.
- (intern (car (elt (cadr entry) 0))))))
-
-(defun paradox--handle-failed-download (&rest _)
- "Handle the case when Emacs fails to download Github data."
- (paradox--update-downloads-in-progress 'paradox--data)
- (unless (hash-table-p paradox--download-count)
- (setq paradox--download-count (make-hash-table)))
- (unless (hash-table-p paradox--package-repo-list)
- (setq paradox--package-repo-list (make-hash-table)))
- (unless (hash-table-p paradox--star-count)
- (setq paradox--star-count (make-hash-table)))
- (unless (hash-table-p paradox--wiki-packages)
- (setq paradox--wiki-packages (make-hash-table)))
- (message "[Paradox] Error downloading Github data"))
-
-(defmacro paradox--with-work-buffer (location file &rest body)
- "Run BODY in a buffer containing the contents of FILE at LOCATION.
-This is the same as `package--with-work-buffer-async', except it
-automatically decides whether to download asynchronously based on
-`package-menu-async'."
- (declare (indent 2) (debug t))
- (require 'package)
- (if (fboundp 'package--with-response-buffer)
- `(package--with-response-buffer
- ,location :file ,file
- :async package-menu-async
- :error-form (paradox--handle-failed-download)
- ,@body
- (paradox--update-downloads-in-progress 'paradox--data))
- `(package--with-work-buffer ,location ,file ,@body)))
-
-(defun paradox--refresh-remote-data ()
- "Download metadata and populate the respective variables."
- (interactive)
- (when (boundp 'package--downloads-in-progress)
- (add-to-list 'package--downloads-in-progress 'paradox--data))
- (condition-case-unless-debug nil
- (paradox--with-work-buffer paradox--data-url "data-hashtables"
- (setq paradox--star-count (read (current-buffer)))
- (setq paradox--package-repo-list (read (current-buffer)))
- (setq paradox--download-count (read (current-buffer)))
- (setq paradox--wiki-packages (read (current-buffer))))
- (error (paradox--handle-failed-download))))
-
-(defun paradox--package-star-count (package)
- "Get the star count of PACKAGE."
- (let ((count (gethash package paradox--star-count nil))
- (repo (gethash package paradox--package-repo-list nil)))
- (propertize
- (format "%s" (or count ""))
- 'font-lock-face
- (if (and repo (paradox--starred-repo-p repo))
- 'paradox-starred-face
- 'paradox-star-face))))
-
-(defun paradox--star-predicate (A B)
- "Non-nil t if star count of A is larger than B."
- (> (string-to-number (elt (cadr A) paradox--column-index-star))
- (string-to-number (elt (cadr B) paradox--column-index-star))))
-(defun paradox--download-predicate (A B)
- "Non-nil t if download count of A is larger than B."
- (> (get-text-property 0 'value (elt (cadr A) paradox--column-index-download))
- (get-text-property 0 'value (elt (cadr B) paradox--column-index-download))))
-
-(defun paradox--generate-menu (remember-pos packages &optional keywords)
- "Populate the Package Menu, without hacking into the header-format.
-If REMEMBER-POS is non-nil, keep point on the same entry.
-PACKAGES should be t, which means to display all known packages,
-or a list of package names (symbols) to display.
-
-With KEYWORDS given, only packages with those keywords are
-shown."
- (paradox-menu--refresh packages keywords)
- (setq paradox--current-filter
- (if keywords (mapconcat 'identity keywords ",")
- nil))
- (let ((idx (paradox--column-index "Package")))
- (when (integerp idx)
- (setcar (elt tabulated-list-format idx)
- (if keywords
- (concat "Package[" paradox--current-filter "]")
- "Package"))))
- (tabulated-list-print remember-pos)
- (tabulated-list-init-header)
- (paradox--update-mode-line))
-
-(defcustom paradox-hide-wiki-packages nil
- "If non-nil, don't display packages from the emacswiki."
- :type 'boolean)
-
-(defun paradox--maybe-remove-wiki-packages (pkgs)
- "Remove wiki packages from PKGS.
-If `paradox-hide-wiki-packages' is nil, just return PKGS."
- (if (not paradox-hide-wiki-packages)
- pkgs
- (remq nil
- (mapcar
- (lambda (entry)
- (let ((name (or (car-safe entry) entry)))
- (unless (gethash name paradox--wiki-packages)
- name)))
- (if (or (not pkgs) (eq t pkgs))
- package-archive-contents
- pkgs)))))
-
-(defun paradox-menu--refresh (&optional packages keywords)
- "Call `package-menu--refresh' retaining current filter.
-PACKAGES and KEYWORDS are passed to `package-menu--refresh'. If
-KEYWORDS is nil and `paradox--current-filter' is non-nil, it is
-used to define keywords."
- (mapc (lambda (x) (setf (cdr x) 0)) paradox--package-count)
- (let ((paradox--desc-prefix (if (> paradox-lines-per-entry 1) " \n " ""))
- (paradox--desc-suffix (make-string (max 0 (- paradox-lines-per-entry 2)) ?\n)))
- (cond
- ((or packages keywords (not paradox--current-filter))
- (package-menu--refresh
- (paradox--maybe-remove-wiki-packages packages)
- keywords)
- (paradox-refresh-upgradeable-packages))
- ((string= paradox--current-filter "Upgradable")
- (paradox-refresh-upgradeable-packages)
- (paradox-filter-upgrades))
- ((string= paradox--current-filter "Starred")
- (paradox-filter-stars)
- (paradox-refresh-upgradeable-packages))
- ((string-match "\\`Regexp:\\(.*\\)\\'" paradox--current-filter)
- (paradox-filter-regexp (match-string 1 paradox--current-filter))
- (paradox-refresh-upgradeable-packages))
- (t
- (paradox-menu--refresh
- packages (split-string paradox--current-filter ","))))))
-
-(defun paradox--column-index (regexp)
- "Find the index of the column that matches REGEXP."
- (cl-position (format "\\`%s\\'" (regexp-quote regexp)) tabulated-list-format
- :test (lambda (x y) (string-match x (or (car-safe y) "")))))
-
-(defun paradox--count-format ()
- "List of star/download counts to be used as part of the entry."
- (remove
- nil
- (list
- (when paradox-display-star-count
- (list paradox--column-name-star paradox-column-width-star
- 'paradox--star-predicate :right-align t))
- (when paradox-display-download-count
- (list paradox--column-name-download paradox-column-width-download
- 'paradox--download-predicate :right-align t)))))
-
-(defun paradox--archive-format ()
- "List containing archive to be used as part of the entry."
- (when (cdr package-archives)
- (list (list "Archive"
- (apply 'max (mapcar 'length (mapcar 'car package-archives)))
- 'package-menu--archive-predicate))))
-
-(add-hook 'paradox-menu-mode-hook 'paradox-refresh-upgradeable-packages)
-
-\f
-;;; Mode Definition
-(define-derived-mode paradox-menu-mode tabulated-list-mode "Paradox Menu"
- "Major mode for browsing a list of packages.
-Letters do not insert themselves; instead, they are commands.
-\\<paradox-menu-mode-map>
-\\{paradox-menu-mode-map}"
- (hl-line-mode 1)
- (when (boundp 'package--post-download-archives-hook)
- (add-hook 'package--post-download-archives-hook
- #'paradox--stop-spinner))
- (if (boundp 'package--downloads-in-progress)
- (setq mode-line-process
- '("" (package--downloads-in-progress
- (":Loading "
- (paradox--spinner
- (:eval (spinner-print paradox--spinner))
- (:eval (paradox--start-spinner))))
- (paradox--spinner
- (":Executing " (:eval (spinner-print paradox--spinner)))))))
- (setq mode-line-process
- '(paradox--spinner
- (":Executing " (:eval (spinner-print paradox--spinner))))))
- (paradox--update-mode-line)
- (setq tabulated-list-format
- `[("Package" ,paradox-column-width-package package-menu--name-predicate)
- ("Version" ,paradox-column-width-version nil)
- ("Status" ,paradox-column-width-status package-menu--status-predicate)
- ,@(paradox--archive-format)
- ,@(paradox--count-format)
- ("Description" 0 nil)])
- (setq paradox--column-index-star
- (paradox--column-index paradox--column-name-star))
- (setq paradox--column-index-download
- (paradox--column-index paradox--column-name-download))
- (setq tabulated-list-padding 2)
- (setq tabulated-list-sort-key (cons "Status" nil))
- (add-hook 'tabulated-list-revert-hook #'paradox-menu--refresh nil t)
- (add-hook 'tabulated-list-revert-hook #'paradox-refresh-upgradeable-packages nil t)
- ;; (add-hook 'tabulated-list-revert-hook #'paradox--refresh-remote-data nil t)
- (add-hook 'tabulated-list-revert-hook #'paradox--update-mode-line 'append t)
- (tabulated-list-init-header)
- ;; We need package-menu-mode to be our parent, otherwise some
- ;; commands throw errors. But we can't actually derive from it,
- ;; otherwise its initialization will screw up the header-format. So
- ;; we "patch" it like this.
- (put 'paradox-menu-mode 'derived-mode-parent 'package-menu-mode)
- (run-hooks 'package-menu-mode-hook))
-
-(put 'paradox-menu-mode 'derived-mode-parent 'package-menu-mode)
-
-(defun paradox--define-sort (name &optional key)
- "Define sorting by column NAME and bind it to KEY.
-Defines a function called paradox-sort-by-NAME."
- (let ((symb (intern (format "paradox-sort-by-%s" (downcase name))))
- (key (or key (substring name 0 1))))
- (eval
- `(progn
- (defun ,symb
- (invert)
- ,(format "Sort Package Menu by the %s column." name)
- (interactive "P")
- (when invert
- (setq tabulated-list-sort-key (cons ,name nil)))
- (tabulated-list--sort-by-column-name ,name))
- (define-key paradox-menu-mode-map ,(concat "S" (upcase key)) ',symb)
- (define-key paradox-menu-mode-map ,(concat "S" (downcase key)) ',symb)))))
-
-(paradox--define-sort "Package")
-(paradox--define-sort "Status")
-(paradox--define-sort paradox--column-name-star "*")
-(declare-function paradox-sort-by-package "paradox-menu")
-
-(defalias 'paradox-filter-clear #'package-show-package-list
- "Clear current Package filter.
-Redisplay the Packages buffer listing all packages, without
-fetching the list.")
-
-(defmacro paradox--apply-filter (name packages &optional nil-message)
- "Apply filter called NAME (a string) listing only PACKAGES.
-PACKAGES should be a list of symbols (the names of packages to
-display) or a list of cons cells whose `car's are symbols.
-NIL-MESSAGE is the message to show if PACKAGES is nil, and
-defaults to: \"No %s packages\"."
- (declare (debug t)
- (indent 1))
- (let* ((n (format "%s" name))
- (cn (capitalize n))
- (dn (downcase n)))
- (macroexp-let2 macroexp-copyable-p pl packages
- `(if (null ,pl)
- (user-error ,(or nil-message (format "No %s packages." dn)))
- (package-show-package-list
- (mapcar (lambda (p) (or (car-safe p) p)) ,pl))
- (setq paradox--current-filter ,cn)))))
-
-(defun paradox-filter-upgrades ()
- "Show only upgradable packages."
- (interactive)
- (paradox--apply-filter Upgradable
- paradox--upgradeable-packages)
- (paradox-sort-by-package nil))
-
-(defun paradox-filter-stars ()
- "Show only starred packages."
- (interactive)
- (let ((list))
- (maphash (lambda (pkg repo)
- (when (paradox--starred-repo-p repo)
- (push pkg list)))
- paradox--package-repo-list)
- (paradox--apply-filter Starred list)))
-
-(defun paradox-filter-regexp (regexp)
- "Show only packages matching REGEXP.
-Test match against name and summary."
- (interactive (list (read-regexp "Enter Regular Expression: ")))
- (paradox--apply-filter Regexp
- (cl-remove-if-not
- (lambda (package)
- (or (string-match-p regexp (symbol-name (car package)))
- (string-match-p regexp (package-desc-summary (cadr package)))))
- package-archive-contents)
- "No packages match this regexp.")
- (setq paradox--current-filter (concat "Regexp:" regexp)))
-
-(set-keymap-parent paradox-menu-mode-map package-menu-mode-map)
-(define-key paradox-menu-mode-map "q" #'paradox-quit-and-close)
-(define-key paradox-menu-mode-map "p" #'paradox-previous-entry)
-(define-key paradox-menu-mode-map "n" #'paradox-next-entry)
-(define-key paradox-menu-mode-map "k" #'paradox-previous-describe)
-(define-key paradox-menu-mode-map "j" #'paradox-next-describe)
-(define-key paradox-menu-mode-map "s" #'paradox-menu-mark-star-unstar)
-(define-key paradox-menu-mode-map "h" #'paradox-menu-quick-help)
-(define-key paradox-menu-mode-map "v" #'paradox-menu-visit-homepage)
-(define-key paradox-menu-mode-map "w" #'paradox-menu-copy-homepage-as-kill)
-(define-key paradox-menu-mode-map "l" #'paradox-menu-view-commit-list)
-(define-key paradox-menu-mode-map "x" #'paradox-menu-execute)
-(define-key paradox-menu-mode-map "\r" #'paradox-push-button)
-(define-key paradox-menu-mode-map "F" 'package-menu-filter)
-(if (version< emacs-version "25")
- (defhydra hydra-paradox-filter (:color blue :hint nil)
- "
-Filter by:
-_u_pgrades _r_egexp _k_eyword _s_tarred _c_lear
-"
- ("f" package-menu-filter)
- ("k" package-menu-filter)
- ("r" paradox-filter-regexp)
- ("u" paradox-filter-upgrades)
- ("s" paradox-filter-stars)
- ("c" paradox-filter-clear)
- ("g" paradox-filter-clear)
- ("q" nil "cancel" :color blue))
- (defhydra hydra-paradox-filter (:color blue :hint nil)
- "
-Filter by:
-_u_pgrades _r_egexp _k_eyword _s_tarred _c_lear
-Archive: g_n_u _o_ther
-Status: _i_nstalled _a_vailable _d_ependency _b_uilt-in
-"
- ("f" package-menu-filter)
- ("k" package-menu-filter)
- ("n" (package-menu-filter "arc:gnu"))
- ("o" (package-menu-filter
- (remove "arc:gnu"
- (mapcar (lambda (e) (concat "arc:" (car e)))
- package-archives))))
- ("r" paradox-filter-regexp)
- ("u" paradox-filter-upgrades)
- ("s" paradox-filter-stars)
- ("i" (package-menu-filter "status:installed"))
- ("a" (package-menu-filter "status:available"))
- ("b" (package-menu-filter "status:built-in"))
- ("d" (package-menu-filter "status:dependency"))
- ("c" paradox-filter-clear)
- ("g" paradox-filter-clear)
- ("q" nil "cancel" :color blue)))
-(define-key paradox-menu-mode-map "f" #'hydra-paradox-filter/body)
-
-;;; for those who don't want a hydra
-(defvar paradox--filter-map)
-(define-prefix-command 'paradox--filter-map)
-(define-key paradox--filter-map "k" #'package-menu-filter)
-(define-key paradox--filter-map "f" #'package-menu-filter)
-(define-key paradox--filter-map "r" #'paradox-filter-regexp)
-(define-key paradox--filter-map "u" #'paradox-filter-upgrades)
-(define-key paradox--filter-map "s" #'paradox-filter-stars)
-(define-key paradox--filter-map "c" #'paradox-filter-clear)
-
-(easy-menu-define paradox-menu-mode-menu paradox-menu-mode-map
- "Menu for `paradox-menu-mode'."
- `("Paradox"
- ["Describe Package" package-menu-describe-package :help "Display information about this package"]
- ["Help" paradox-menu-quick-help :help "Show short key binding help for package-menu-mode"]
-
- "--"
- ["Refresh Package List" package-menu-refresh
- :help "Redownload the ELPA archive"
- :active (not package--downloads-in-progress)]
- ["Execute Marked Actions" paradox-menu-execute :help "Perform all the marked actions"]
- ["Mark All Available Upgrades" package-menu-mark-upgrades
- :help "Mark packages that have a newer version for upgrading"
- :active (not package--downloads-in-progress)]
-
- ("Other Mark Actions"
- ["Mark All Obsolete for Deletion" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion"]
- ["Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line"]
- ["Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line"]
- ["Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line"])
-
- "--"
- ("Github" :visible (stringp paradox-github-token)
- ["Star or unstar this package" paradox-menu-mark-star-unstar]
- ["Star all installed packages" paradox-star-all-installed-packages]
- ["Star packages when installing" (customize-save-variable 'paradox-automatically-star (not paradox-automatically-star))
- :help "Automatically star packages that you install (and unstar packages you delete)"
- :style toggle :selected paradox-automatically-star])
- ["Configure Github Inegration" (paradox--check-github-token) :visible (not paradox-github-token)]
- ["View Changelog" paradox-menu-view-commit-list :help "Show a package's commit list on Github"]
- ["Visit Homepage" paradox-menu-visit-homepage :help "Visit a package's Homepage on a browser"]
-
- "--"
- ("Filter Package List"
- ["Clear filter" paradox-filter-clear :help "Go back to unfiltered list"]
- ["By Keyword" package-menu-filter :help "Filter by package keyword"]
- ["By Upgrades" paradox-filter-upgrades :help "List only upgradeable packages"]
- ["By Regexp" paradox-filter-regexp :help "Filter packages matching a regexp"]
- ["By Starred" paradox-filter-stars :help "List only packages starred by the user"])
- ("Sort Package List"
- ["By Package Name" paradox-sort-by-package]
- ["By Status (default)" paradox-sort-by-status]
- ["By Number of Stars" paradox-sort-by-★])
- ["Hide by Regexp" package-menu-hide-package :help "Permanently hide all packages matching a regexp"]
- ["Display Older Versions" package-menu-toggle-hiding
- :style toggle :selected (not package-menu--hide-packages)
- :help "Display package even if a newer version is already installed"]
-
- "--"
- ["Quit" quit-window :help "Quit package selection"]
- ["Customize" (customize-group 'package)]))
-
-\f
-;;; Menu Mode Commands
-(defun paradox-previous-entry (&optional n)
- "Move to previous entry, which might not be the previous line.
-With prefix N, move to the N-th previous entry."
- (interactive "p")
- (paradox-next-entry (- n))
- (forward-line 0)
- (forward-button 1))
-
-(defun paradox-next-entry (&optional n)
- "Move to next entry, which might not be the next line.
-With prefix N, move to the N-th next entry."
- (interactive "p")
- (dotimes (_ (abs n))
- (let ((d (cl-signum n)))
- (forward-line (if (> n 0) 1 0))
- (if (eobp) (forward-line -1))
- (forward-button d))))
-
-(defun paradox-next-describe (&optional n)
- "Move to the next package and describe it.
-With prefix N, move to the N-th next package instead."
- (interactive "p")
- (paradox-next-entry n)
- (call-interactively 'package-menu-describe-package))
-
-(defun paradox-previous-describe (&optional n)
- "Move to the previous package and describe it.
-With prefix N, move to the N-th previous package instead."
- (interactive "p")
- (paradox-previous-entry n)
- (call-interactively 'package-menu-describe-package))
-
-(defun paradox-push-button ()
- "Push button under point, or describe package."
- (interactive)
- (if (get-text-property (point) 'action)
- (call-interactively 'push-button)
- (call-interactively 'package-menu-describe-package)))
-
-(defvar paradox--key-descriptors
- '(("next," "previous," "install," "delete," ("execute," . 1) "refresh," "help")
- ("star," "visit homepage," "unmark," ("mark Upgrades," . 5) "~delete obsolete")
- ("list commits")
- ("filter by" "+" "upgrades" "regexp" "keyword" "starred" "clear")
- ("Sort by" "+" "Package name" "Status" "*(star)")))
-
-(defun paradox-menu-quick-help ()
- "Show short key binding help for `paradox-menu-mode'.
-The full list of keys can be viewed with \\[describe-mode]."
- (interactive)
- (message (mapconcat 'paradox--prettify-key-descriptor
- paradox--key-descriptors "\n")))
-
-(defun paradox-quit-and-close (kill)
- "Bury this buffer and close the window.
-With prefix KILL, kill the buffer instead of burying."
- (interactive "P")
- (let ((log (get-buffer-window paradox--commit-list-buffer)))
- (when (window-live-p log)
- (quit-window kill log))
- (quit-window kill)))
-
-(defun paradox-menu-visit-homepage (pkg)
- "Visit the homepage of package named PKG.
-PKG is a symbol. Interactively it is the package under point."
- (interactive '(nil))
- (let ((url (paradox--package-homepage
- (paradox--get-or-return-package pkg))))
- (if (stringp url)
- (browse-url url)
- (message "Package %s has no homepage."
- (propertize (symbol-name pkg)
- 'face 'font-lock-keyword-face)))))
-
-(defun paradox-menu-copy-homepage-as-kill (pkg)
- "Save the homepage of package named PKG as kill.
-PKG is a symbol. Interactively it is the package under point."
- (interactive '(nil))
- (let ((url (paradox--package-homepage
- (paradox--get-or-return-package pkg))))
- (if (stringp url)
- (progn (kill-new url)
- (message "copied \"%s\"" url))
- (message "Package %s has no homepage."
- (propertize (symbol-name pkg)
- 'face 'font-lock-keyword-face)))))
-
-(defun paradox-menu-mark-star-unstar ()
- "Star or unstar a package and move to the next line."
- (interactive)
- (paradox--enforce-github-token
- (unless paradox--user-starred-repos
- (paradox--refresh-user-starred-list))
- ;; Get package name
- (let* ((pkg (paradox--get-or-return-package nil))
- (repo (gethash pkg paradox--package-repo-list))
- will-delete)
- (unless pkg (error "Couldn't find package-name for this entry"))
- ;; (Un)Star repo
- (if (not repo)
- (message "This package is not a GitHub repo.")
- (setq will-delete (paradox--starred-repo-p repo))
- (paradox--star-repo repo will-delete)
- (cl-incf (gethash pkg paradox--star-count 0)
- (if will-delete -1 1))
- (tabulated-list-set-col paradox--column-name-star
- (paradox--package-star-count pkg)))))
- (forward-line 1))
-
-(defun paradox-menu-view-commit-list (pkg)
- "Visit the commit list of package named PKG.
-PKG is a symbol. Interactively it is the package under point."
- (interactive '(nil))
- (let* ((name (paradox--get-or-return-package pkg))
- (repo (gethash name paradox--package-repo-list)))
- (if repo
- (with-selected-window
- (display-buffer (get-buffer-create paradox--commit-list-buffer))
- (paradox-commit-list-mode)
- (setq paradox--package-repo repo)
- (setq paradox--package-name name)
- (setq paradox--package-version
- (paradox--get-installed-version name))
- (setq paradox--package-tag-commit-alist
- (paradox--get-tag-commit-alist repo))
- (paradox--commit-list-update-entries)
- (tabulated-list-print))
- (message "Package %s is not a GitHub repo." pkg))))
-
-\f
-;;; Mode-line Construction
-(defcustom paradox-local-variables
- '(mode-line-mule-info
- mode-line-client
- mode-line-remote mode-line-position
- column-number-mode size-indication-mode)
- "Variables which will take special values on the Packages buffer.
-This is a list, where each element is either SYMBOL or (SYMBOL . VALUE).
-
-Each SYMBOL (if it is bound) will be locally set to VALUE (or
-nil) on the Packages buffer."
- :type '(repeat (choice symbol (cons symbol sexp)))
- :group 'paradox-menu
- :package-version '(paradox . "0.1"))
-
-(defcustom paradox-display-buffer-name nil
- "If nil, *Packages* buffer name won't be displayed in the mode-line."
- :type 'boolean
- :group 'paradox-menu
- :package-version '(paradox . "0.2"))
-
-(defun paradox--build-buffer-id (st n)
- "Return a list that propertizes ST and N for the mode-line."
- `((:propertize ,st
- face paradox-mode-line-face)
- (:propertize ,(int-to-string n)
- face mode-line-buffer-id)))
-
-(defun paradox--update-mode-line ()
- "Update `mode-line-format'."
- (mapc #'paradox--set-local-value paradox-local-variables)
- (let ((total-lines (int-to-string (length tabulated-list-entries))))
- (paradox--update-mode-line-front-space total-lines)
- (paradox--update-mode-line-buffer-identification total-lines)))
-
-(defun paradox--update-mode-line-buffer-identification (_total-lines)
- "Update `mode-line-buffer-identification'.
-TOTAL-LINES is currently unused."
- (require 'spinner)
- (setq mode-line-buffer-identification
- `((paradox-display-buffer-name
- ,(propertized-buffer-identification
- (format "%%%sb" (length (buffer-name)))))
- (paradox--current-filter (:propertize ("[" paradox--current-filter "]") face paradox-mode-line-face))
- (paradox--upgradeable-packages-any?
- (:eval (paradox--build-buffer-id " Upgrade:" paradox--upgradeable-packages-number)))
- (package-menu--new-package-list
- (:eval (paradox--build-buffer-id " New:" (paradox--cas "new"))))
- ,(paradox--build-buffer-id " Installed:" (+ (paradox--cas "installed")
- (paradox--cas "dependency")
- (paradox--cas "unsigned")))
- (paradox--current-filter
- "" ,(paradox--build-buffer-id " Total:" (length package-archive-contents))))))
-
-(defvar sml/col-number)
-(defvar sml/numbers-separator)
-(defvar sml/col-number-format)
-(defvar sml/line-number-format)
-(defvar sml/position-construct)
-(declare-function sml/compile-position-construct "sml")
-(defvar sml/post-id-separator)
-(defun paradox--update-mode-line-front-space (total-lines)
- "Update `mode-line-front-space'.
-TOTAL-LINES is the number of lines in the buffer."
- (if (memq 'sml/post-id-separator mode-line-format)
- (progn
- (add-to-list (make-local-variable 'mode-line-front-space)
- (propertize " (" 'face 'sml/col-number))
- (setq column-number-mode line-number-mode)
- (set (make-local-variable 'sml/numbers-separator) "")
- (set (make-local-variable 'sml/col-number-format)
- (format "/%s)" total-lines))
- (set (make-local-variable 'sml/line-number-format)
- (format "%%%sl" (length total-lines)))
- (make-local-variable 'sml/position-construct)
- (sml/compile-position-construct))
- (set (make-local-variable 'mode-line-front-space)
- `(line-number-mode
- ("(" (:propertize ,(format "%%%sl" (length total-lines)) face mode-line-buffer-id) "/"
- ,total-lines ")")))
- (set (make-local-variable 'mode-line-modified) nil)))
-
-(defun paradox--set-local-value (x)
- "Locally set value of (car X) to (cdr X)."
- (let ((sym (or (car-safe x) x)))
- (when (boundp sym)
- (set (make-local-variable sym) (cdr-safe x)))))
-
-(defun paradox--prettify-key-descriptor (desc)
- "Prettify DESC to be displayed as a help menu."
- (if (listp desc)
- (if (listp (cdr desc))
- (mapconcat 'paradox--prettify-key-descriptor desc " ")
- (let ((place (cdr desc))
- (out (car desc)))
- (setq out (propertize out 'face 'paradox-comment-face))
- (add-text-properties place (1+ place) '(face paradox-highlight-face) out)
- out))
- (paradox--prettify-key-descriptor (cons desc 0))))
-
-(provide 'paradox-menu)
-;;; paradox-menu.el ends here
+++ /dev/null
-(define-package "paradox" "20181027.2234" "A modern Packages Menu. Colored, with package ratings, and customizable."
- '((emacs "24.4")
- (seq "1.7")
- (let-alist "1.0.3")
- (spinner "1.7.3")
- (hydra "0.13.2"))
- :keywords
- '("package" "packages")
- :authors
- '(("Artur Malabarba" . "emacsNOSPAMendlessparentheses.com"))
- :maintainer
- '("Artur Malabarba" . "emacsNOSPAMendlessparentheses.com")
- :url "https://github.com/Malabarba/paradox")
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; paradox.el --- A modern Packages Menu. Colored, with package ratings, and customizable. -*- lexical-binding:t -*-
-
-;; Copyright (C) 2014-2015 Artur Malabarba <emacsNOSPAMendlessparentheses.com>
-
-;; Author: Artur Malabarba <emacsNOSPAMendlessparentheses.com>
-;; URL: https://github.com/Malabarba/paradox
-;; Version: 2.5.1
-;; Keywords: package packages
-;; Package-Requires: ((emacs "24.4") (seq "1.7") (let-alist "1.0.3") (spinner "1.7.3") (hydra "0.13.2"))
-;; Prefix: paradox
-;; Separator: -
-
-;;; Commentary:
-;;
-;; Paradox can be installed from Melpa with M-x `package-install' RET
-;; paradox.
-;; It can also be installed manually in the usual way, just be mindful of
-;; the dependencies.
-;;
-;; To use it, simply call M-x `paradox-list-packages' (instead of the
-;; regular `list-packages').
-;; This will give you most features out of the box. If you want to be
-;; able to star packages as well, just configure the
-;; `paradox-github-token' variable then call `paradox-list-packages'
-;; again.
-;;
-;; If you'd like to stop using Paradox, you may call `paradox-disable'
-;; and go back to using the regular `list-packages'.
-;;
-;; ## Current Features ##
-;;
-;; ### Several Improvements ###
-;;
-;; Paradox implements many small improvements to the package menu
-;; itself. They all work out of the box and are completely customizable!
-;; *(Also, hit `h' to see all keys.)*
-;;
-;; * Visit the package's homepage with `v' (or just use the provided buttons).
-;; * Shortcuts for package filtering:
-;; * <f r> filters by regexp (`occur');
-;; * <f u> display only packages with upgrades;
-;; * <f k> filters by keyword (Emacs 24.4 only).
-;; * `hl-line-mode' enabled by default.
-;; * Display useful information on the mode-line and cleanup a bunch of
-;; useless stuff.
-;; * **Customization!** Just call M-x `paradox-customize' to see what you can
-;; do.
-;; * Customize column widths.
-;; * Customize faces (`paradox-star-face', `paradox-status-face-alist' and `paradox-archive-face').
-;; * Customize local variables.
-;;
-;; ### Package Ratings ###
-;;
-;; Paradox also integrates with
-;; **GitHub Stars**, which works as **rough** package rating system.
-;; That is, Paradox package menu will:
-;;
-;; 1. Display the number of GitHub Stars each package has (assuming it's
-;; in a github repo, of course);
-;; 2. Possibly automatically star packages you install, and unstar
-;; packages you delete (you will be asked the first time whether you
-;; want this);
-;; 3. Let you star and unstar packages by hitting the `s' key;
-;; 4. Let you star all packages you have installed with M-x `paradox-star-all-installed-packages'.
-;;
-;; Item **1.** will work out of the box, the other items obviously
-;; require a github account (Paradox will help you generate a token the
-;; first time you call `paradox-list-packages').
-;;
-;; ## How Star Displaying Works ##
-;;
-;; We generate a map of Package Name -> Repository from
-;; [Melpa](https://github.com/milkypostman/melpa.git)'s `recipe'
-;; directory, some repos may correspond to more than one package.
-;; This map is used count the stars a given package has.
-;; _This doesn't mean you need Melpa to see the star counts, the numbers
-;; will be displayed regardless of what archives you use._
-;;
-;; Currently, packages that are not hosted on GitHub are listed with a
-;; blank star count, which is clearly different from 0-star packages
-;; (which are displayed with a 0, obviously).
-;; If you know of an alternative that could be used for these packages,
-;; [open an issue](https://github.com/Bruce-Connor/paradox/issues/new)
-;; here, I'd love to hear.
-
-;;; License:
-;;
-;; This file is NOT part of GNU Emacs.
-;;
-;; 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 2
-;; 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.
-
-\f
-;;; Code:
-
-(require 'package)
-(require 'cl-lib)
-
-(require 'paradox-core)
-(require 'paradox-execute)
-(require 'paradox-menu)
-
-(defconst paradox-version "2.5.1" "Version of the paradox.el package.")
-(defun paradox-bug-report ()
- "Opens github issues page in a web browser. Please send any bugs you find.
-Please include your Emacs and paradox versions."
- (interactive)
- (message "Your paradox-version is: %s, and your emacs version is: %s.\nPlease include this in your report!"
- paradox-version emacs-version)
- (browse-url "https://github.com/Bruce-Connor/paradox/issues/new"))
-(defun paradox-customize ()
- "Open the customization menu in the `paradox' group."
- (interactive)
- (customize-group 'paradox t))
-(defgroup paradox nil
- "Customization group for paradox."
- :prefix "paradox-"
- :group 'emacs
- :package-version '(paradox . "0.1"))
-
-\f
-;;; External Commands
-;;;###autoload
-(defun paradox-list-packages (no-fetch)
- "Improved version of `package-list-packages'. The heart of Paradox.
-Function is equivalent to `package-list-packages' (including the
-prefix NO-FETCH), but the resulting Package Menu is improved in
-several ways.
-
-Among them:
-
-1. Uses `paradox-menu-mode', which has more functionality and
-keybinds than `package-menu-mode'.
-
-2. Uses some font-locking to improve readability.
-
-3. Optionally shows the number GitHub stars and Melpa downloads
-for packages.
-
-4. Adds useful information in the mode-line."
- (interactive "P")
- (when (paradox--check-github-token)
- (paradox-enable)
- (let ((is-25 (fboundp 'package--with-response-buffer)))
- (unless no-fetch
- (if is-25
- (add-to-list 'package--downloads-in-progress 'paradox--data)
- (paradox--refresh-remote-data)))
- (package-list-packages no-fetch)
- (unless no-fetch
- (when (stringp paradox-github-token)
- (paradox--refresh-user-starred-list
- (bound-and-true-p package-menu-async)))
- (when is-25
- (paradox--refresh-remote-data))))))
-
-;;;###autoload
-(defun paradox-upgrade-packages (&optional no-fetch)
- "Upgrade all packages. No questions asked.
-This function is equivalent to `list-packages', followed by a
-`package-menu-mark-upgrades' and a `package-menu-execute'. Except
-the user isn't asked to confirm deletion of packages.
-
-If `paradox-execute-asynchronously' is non-nil, part of this
-operation may be performed in the background.
-
-The NO-FETCH prefix argument is passed to `list-packages'. It
-prevents re-download of information about new versions. It does
-not prevent downloading the actual packages (obviously)."
- (interactive "P")
- (save-window-excursion
- (let ((package-menu-async nil))
- (paradox-list-packages no-fetch))
- (package-menu-mark-upgrades)
- (paradox-menu-execute 'noquery)))
-
-(defun paradox-enable ()
- "Enable paradox, overriding the default package-menu."
- (interactive)
- (when (and (fboundp 'package--update-downloads-in-progress)
- (not (fboundp 'package--with-response-buffer)))
- (message "[Paradox] Your Emacs snapshot is outdated, please install a more recent one.")
- (setq package-menu-async nil))
- (paradox--override-definition 'package-menu--print-info 'paradox--print-info)
- (when (fboundp 'package-menu--print-info-simple)
- (paradox--override-definition 'package-menu--print-info-simple 'paradox--print-info))
- (paradox--override-definition 'package-menu--generate 'paradox--generate-menu)
- ;; Tough it may not look like it, this is totally necessary too.
- (paradox--override-definition 'package-menu-mode 'paradox-menu-mode)
- (paradox--core-enable))
-
-;;;###autoload
-(defun paradox-require (feature &optional filename noerror package refresh)
- "Like `require', but also install FEATURE if it is absent.
-FILENAME is passed to `require'.
-If NOERROR is non-nil, don't complain if the feature couldn't be
-installed, just return nil.
-
-- If FEATURE is present, `require' it and return t.
-
-- If FEATURE is not present, install PACKAGE with `package-install'.
-If PACKAGE is nil, assume FEATURE is the package name.
-After installation, `require' FEATURE.
-
-By default, the current package database is only updated if it is
-empty. Passing a non-nil REFRESH argument forces this update."
- (or (require feature filename t)
- (let ((package (or package
- (if (stringp feature)
- (intern feature)
- feature))))
- (require 'package)
- (unless (and package-archive-contents (null refresh))
- (package-refresh-contents))
- (and (condition-case e
- (package-install package)
- (error (if noerror nil (error (cadr e)))))
- (require feature filename noerror)))))
-
-(provide 'paradox)
-;;; paradox.el ends here
--- /dev/null
+;;; paradox-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
+\f
+;;;### (autoloads nil "paradox" "paradox.el" (23994 46387 773446
+;;;;;; 457000))
+;;; Generated autoloads from paradox.el
+
+(autoload 'paradox-list-packages "paradox" "\
+Improved version of `package-list-packages'. The heart of Paradox.
+Function is equivalent to `package-list-packages' (including the
+prefix NO-FETCH), but the resulting Package Menu is improved in
+several ways.
+
+Among them:
+
+1. Uses `paradox-menu-mode', which has more functionality and
+keybinds than `package-menu-mode'.
+
+2. Uses some font-locking to improve readability.
+
+3. Optionally shows the number GitHub stars and Melpa downloads
+for packages.
+
+4. Adds useful information in the mode-line.
+
+\(fn NO-FETCH)" t nil)
+
+(autoload 'paradox-upgrade-packages "paradox" "\
+Upgrade all packages. No questions asked.
+This function is equivalent to `list-packages', followed by a
+`package-menu-mark-upgrades' and a `package-menu-execute'. Except
+the user isn't asked to confirm deletion of packages.
+
+If `paradox-execute-asynchronously' is non-nil, part of this
+operation may be performed in the background.
+
+The NO-FETCH prefix argument is passed to `list-packages'. It
+prevents re-download of information about new versions. It does
+not prevent downloading the actual packages (obviously).
+
+\(fn &optional NO-FETCH)" t nil)
+
+(autoload 'paradox-enable "paradox" "\
+Enable paradox, overriding the default package-menu.
+
+\(fn)" t nil)
+
+(autoload 'paradox-require "paradox" "\
+Like `require', but also install FEATURE if it is absent.
+FILENAME is passed to `require'.
+If NOERROR is non-nil, don't complain if the feature couldn't be
+installed, just return nil.
+
+- If FEATURE is present, `require' it and return t.
+
+- If FEATURE is not present, install PACKAGE with `package-install'.
+If PACKAGE is nil, assume FEATURE is the package name.
+After installation, `require' FEATURE.
+
+By default, the current package database is only updated if it is
+empty. Passing a non-nil REFRESH argument forces this update.
+
+\(fn FEATURE &optional FILENAME NOERROR PACKAGE REFRESH)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("paradox-commit-list.el" "paradox-core.el"
+;;;;;; "paradox-execute.el" "paradox-github.el" "paradox-menu.el"
+;;;;;; "paradox-pkg.el") (23994 46387 774569 56000))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; paradox-autoloads.el ends here
--- /dev/null
+;;; paradox-commit-list.el --- listing commits for a package's repository -*- lexical-binding:t -*-
+
+;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+;; Prefix: paradox
+;; Separator: -
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; 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 2
+;; 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.
+;;
+
+\f
+;;; Code:
+(require 'subr-x)
+(require 'cl-lib)
+(require 'package)
+
+(require 'paradox-github)
+
+(defgroup paradox-commit-list nil
+ "Buffer used by paradox to list commits for a package."
+ :prefix "paradox-"
+ :package-version '(paradox . "2.0")
+ :group 'paradox)
+
+\f
+;;; Variables
+(defcustom paradox-commit-list-query-max-pages 1
+ "Max number of pages we read from github when fetching the commit-list.
+Each page lists 100 commits, so 1 page should be more than enough
+for most repositories.
+
+Increasing this number consequently multiplies the time it takes
+to load the commit list on repos which actually use that many
+pages."
+ :type 'integer
+ :group 'paradox-commit-list
+ :package-version '(paradox . "1.2.3"))
+
+(defcustom paradox-date-format "%Y-%m-%d"
+ "Format used for the date displayed on the commit list.
+See `format-time-string' for more information.
+
+Set it to \"%x\" for a more \"human\" date format."
+ :type 'string
+ :group 'paradox-commit-list
+ :package-version '(paradox . "1.2.3"))
+
+(defface paradox-commit-tag-face
+ '((t :foreground "goldenrod4"
+ :background "LemonChiffon1"
+ :box 1))
+ "Face used for tags on the commit list."
+ :group 'paradox-commit-list)
+
+\f
+;;; Variables
+(defvar paradox--commit-message-face nil
+ "Face currently being used on commit messages.
+Gets dynamically changed to `font-lock-comment-face' on old commits.
+nil means `default'.")
+
+(defvar-local paradox--package-repo nil
+ "Repo of the package in a commit-list buffer.")
+(defvar-local paradox--package-name nil
+ "Name of the package in a commit-list buffer.")
+(defvar-local paradox--package-version nil
+ "Installed version of the package in a commit-list buffer.")
+(defvar-local paradox--package-tag-commit-alist nil
+ "Alist of (COMMIT-SHA . TAG) for this package's repo.")
+
+(define-button-type 'paradox-commit
+ 'action #'paradox-commit-list-visit-commit
+ 'follow-link t)
+
+;; Use `font-lock-face' on creation instead.
+(button-type-put 'paradox-commit 'face nil)
+
+\f
+;;; Functions
+(defun paradox--get-tag-commit-alist (repo)
+ "Get REPO's tag list and associate them to commit hashes."
+ (require 'json)
+ (mapcar
+ (lambda (x)
+ (cons
+ (cdr (assoc 'sha (cdr (assoc 'commit x))))
+ (cdr (assoc 'name x))))
+ (let ((json-array-type 'list))
+ (paradox--github-action
+ (format "repos/%s/tags?per_page=100" repo)
+ :reader #'json-read
+ :max-pages paradox-commit-list-query-max-pages))))
+
+(defun paradox--get-installed-version (pkg)
+ "Return the installed version of PKG.
+- If PKG isn't installed, return '(0).
+- If it has a Melpa-like version (YYYYMMDD HHMM), return it as a
+ time value.
+- If it has a regular version number, return it as a string."
+ (let ((desc (cadr (assoc pkg package-alist))))
+ (if desc
+ (let ((version (package-desc-version desc)))
+ (if (> (car version) 19000000)
+ (date-to-time
+ (format "%8dT%02d:%02d"
+ (car version)
+ (/ (cadr version) 100)
+ (% (cadr version) 100)))
+ ;; Regular version numbers.
+ (mapconcat 'int-to-string version ".")))
+ '(0 0))))
+
+(defun paradox--commit-tabulated-list (repo)
+ "Return the tabulated list for REPO's commit list."
+ (require 'json)
+ (let* ((paradox--commit-message-face nil)
+ (json-array-type 'list)
+ (feed (paradox--github-action
+ (format "repos/%s/commits?per_page=100" repo)
+ :reader #'json-read
+ :max-pages paradox-commit-list-query-max-pages)))
+ (apply 'append (mapcar 'paradox--commit-print-info feed))))
+
+(defun paradox--commit-print-info (x)
+ "Parse json in X into a tabulated list entry."
+ (let* ((commit (cdr (assoc 'commit x)))
+ (date (date-to-time (cdr (assoc 'date (cdr (assoc 'committer commit))))))
+ (title (split-string (cdr (assoc 'message commit)) "[\n\r][ \t]*" t))
+ ;; (url (cdr (assoc 'html_url commit)))
+ (cc (cdr (assoc 'comment_count commit)))
+ (sha (cdr (assoc 'sha x)))
+ (tag (cdr (assoc-string sha paradox--package-tag-commit-alist))))
+ ;; Have we already crossed the installed commit, or is it not even installed?
+ (unless (or paradox--commit-message-face
+ (equal '(0) paradox--package-version))
+ ;; Is this where we cross to old commits?
+ (when (paradox--version<= date tag)
+ (setq paradox--commit-message-face 'paradox-comment-face)))
+ ;; Return the tabulated list entry.
+ (cons
+ ;; The ID
+ (list `((is-old . ,(null paradox--commit-message-face))
+ (lisp-date . ,date)
+ ,@x)
+ ;; The actual displayed data
+ (vector
+ (make-text-button
+ (format-time-string paradox-date-format date) nil
+ 'type 'paradox-commit
+ 'font-lock-face (or paradox--commit-message-face 'button))
+ (concat (if (> cc 0)
+ (propertize (format "(%s comments) " cc)
+ 'face 'font-lock-function-name-face)
+ "")
+ (if (stringp tag)
+ (propertize tag 'face 'paradox-commit-tag-face)
+ "")
+ (if (stringp tag) " " "")
+ (propertize (or (car-safe title) "")
+ 'face paradox--commit-message-face))))
+ (mapcar (lambda (m) (list x (vector "" (propertize m 'face paradox--commit-message-face))))
+ (cdr title)))))
+
+(defun paradox--version<= (date version)
+ "Non-nil if commit at DATE tagged with VERSION is older or equal to `paradox--package-version'."
+ ;; Melpa date-like versions
+ (if (listp paradox--package-version)
+ ;; Installed date >= to commit date
+ (null (time-less-p paradox--package-version date))
+ ;; Regular version numbers.
+ (and version
+ (ignore-errors (version<= version paradox--package-version)))))
+
+(defun paradox--commit-list-update-entries ()
+ "Update entries of current commit-list."
+ (setq tabulated-list-entries
+ (paradox--commit-tabulated-list paradox--package-repo)))
+
+\f
+;;; Commands
+(defun paradox-commit-list-visit-commit (&optional _)
+ "Visit this commit on GitHub.
+IGNORE is ignored."
+ (interactive)
+ (when (derived-mode-p 'paradox-commit-list-mode)
+ (browse-url (cdr (assoc 'html_url (tabulated-list-get-id))))))
+
+(defun paradox-previous-commit (&optional n)
+ "Move to previous commit, which might not be the previous line.
+With prefix N, move to the N-th previous commit."
+ (interactive "p")
+ (paradox-next-commit (- n)))
+
+(defun paradox-next-commit (&optional n)
+ "Move to next commit, which might not be the next line.
+With prefix N, move to the N-th next commit."
+ (interactive "p")
+ (dotimes (_ (abs n))
+ (let ((d (cl-signum n)))
+ (forward-line d)
+ (while (looking-at " +")
+ (forward-line d)))))
+
+\f
+;;; Mode definition
+(define-derived-mode paradox-commit-list-mode
+ tabulated-list-mode "Paradox Commit List"
+ "Major mode for browsing a list of commits.
+Letters do not insert themselves; instead, they are commands.
+\\<paradox-commit-list-mode-map>
+\\{paradox-commit-list-mode-map}"
+ (hl-line-mode 1)
+ (setq tabulated-list-format
+ `[("Date" ,(length (format-time-string paradox-date-format (current-time))) nil)
+ ("Message" 0 nil)])
+ (setq tabulated-list-padding 1)
+ (setq tabulated-list-sort-key nil)
+ (add-hook 'tabulated-list-revert-hook 'paradox--commit-list-update-entries nil t)
+ (tabulated-list-init-header))
+
+(define-key paradox-commit-list-mode-map "\r" #'paradox-commit-list-visit-commit)
+(define-key paradox-commit-list-mode-map "p" #'paradox-previous-commit)
+(define-key paradox-commit-list-mode-map "n" #'paradox-next-commit)
+
+
+(provide 'paradox-commit-list)
+;;; paradox-commit-list.el ends here.
--- /dev/null
+;;; paradox-core.el --- common functions -*- lexical-binding:t -*-
+
+;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+;; Prefix: paradox
+;; Separator: -
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; 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 2
+;; 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.
+;;
+
+;;; Code:
+(require 'subr-x)
+
+\f
+;;; Configurations
+(defface paradox-comment-face
+ '((((background light)) :foreground "Grey30")
+ (((background dark)) :foreground "Grey60"))
+ "Face used on faded out stuff."
+ :group 'paradox-menu
+ :group 'paradox-commit-list)
+(defface paradox-highlight-face
+ '((t :weight bold :inherit font-lock-variable-name-face))
+ "Face used on highlighted stuff."
+ :group 'paradox-menu
+ :group 'paradox-commit-list)
+
+\f
+;;; Internal variables
+(defvar paradox--star-count (make-hash-table))
+(defvar paradox--download-count (make-hash-table))
+(defvar paradox--package-repo-list (make-hash-table))
+(defvar paradox--wiki-packages (make-hash-table))
+
+(defconst paradox--data-url
+ "https://raw.githubusercontent.com/Malabarba/paradox/data/"
+ "Address of Paradox's data directory.")
+
+(defconst paradox--star-count-url (concat paradox--data-url "data-hashtables")
+ "Address of the raw star-count file.")
+(make-obsolete-variable 'paradox--star-count-url 'paradox--data-url "2.1")
+
+(defconst paradox--package-count
+ '(("total" . 0) ("built-in" . 0)
+ ("obsolete" . 0) ("deleted" . 0)
+ ("available" . 0) ("new" . 0)
+ ("held" . 0) ("disabled" . 0)
+ ("dependency" . 0) ("avail-obso" . 0)
+ ("incompat" . 0) ("external" . 0)
+ ("installed" . 0) ("unsigned" . 0)))
+
+(defmacro paradox--cas (string)
+ "Same as (cdr (assoc-string ,STRING paradox--package-count))."
+ `(cdr (assoc-string ,string paradox--package-count)))
+
+(defun paradox--truncate-string-to-width-filter (args)
+ "Filter the args of `truncate-string-to-width' to use \"…\".
+All arguments STR, END-COLUMN, START-COLUMN, PADDING, and
+ELLIPSIS are passed to `truncate-string-to-width'."
+ (when (and (eq major-mode 'paradox-menu-mode)
+ (eq t (nth 4 args)))
+ (setf (nth 4 args) (if (char-displayable-p ?…) "…" "$")))
+ args)
+
+\f
+;;; Overriding definitions
+(defvar paradox--backups nil)
+
+(defun paradox--core-enable ()
+ "Enable core features."
+ (ignore-errors (setcdr (assq 'menu-bar package-menu-mode-map) nil))
+ (advice-add #'truncate-string-to-width :filter-args
+ #'paradox--truncate-string-to-width-filter
+ '((name . :paradox-override)))
+ (add-to-list 'paradox--backups 'truncate-string-to-width))
+
+(defun paradox-disable ()
+ "Disable paradox, and go back to regular package-menu."
+ (interactive)
+ (when paradox--backups
+ (message "Restoring %s" (mapconcat #'symbol-name paradox--backups ", "))
+ (dolist (it paradox--backups)
+ (advice-remove it :paradox-override))
+ (setq paradox--backups nil)))
+
+(defun paradox--override-definition (sym newdef)
+ "Temporarily override SYM's function definition with NEWDEF.
+Record that in `paradox--backups', but do nothing if
+`paradox--backups' reports that it is already overriden."
+ (unless (memq sym paradox--backups)
+ (message "Overriding %s with %s" sym newdef)
+ (advice-add sym :override newdef '((name . :paradox-override)))
+ (add-to-list 'paradox--backups sym)))
+
+\f
+;;; Pre 25.1 support
+(defun paradox--update-downloads-in-progress (&optional name)
+ (if (and name (fboundp 'package--update-downloads-in-progress))
+ (package--update-downloads-in-progress name)
+ (when (bound-and-true-p package--downloads-in-progress)
+ (setq package--downloads-in-progress
+ (remove name package--downloads-in-progress)))))
+(define-obsolete-function-alias
+ 'paradox--pdate-downloads-in-progress
+ 'paradox--update-downloads-in-progress
+ "2.1")
+
+\f
+;;; Spinner
+(defvar paradox--spinner nil)
+
+(eval-and-compile (require 'spinner))
+(defcustom paradox-spinner-type 'horizontal-moving
+ "Holds the type of spinner to be used in the mode-line.
+Takes a value accepted by `spinner-start'."
+ :type `(choice (choice :tag "Choose a spinner by name"
+ ,@(mapcar (lambda (c) (list 'const (car c)))
+ spinner-types))
+ (const :tag "A random spinner" random)
+ (repeat :tag "A list of symbols from `spinner-types' to randomly choose from"
+ (choice :tag "Choose a spinner by name"
+ ,@(mapcar (lambda (c) (list 'const (car c)))
+ spinner-types)))
+ (vector :tag "A user defined vector"
+ (repeat :inline t string)))
+ :package-version '(paradox . "2.1")
+ :group 'paradox-execute)
+
+(defun paradox--start-spinner ()
+ (when (spinner-p paradox--spinner)
+ (spinner-stop paradox--spinner))
+ (setq paradox--spinner
+ (make-spinner paradox-spinner-type t 10))
+ (spinner-start paradox--spinner))
+
+(defun paradox--stop-spinner ()
+ (when (spinner-p paradox--spinner)
+ (spinner-stop paradox--spinner))
+ (setq paradox--spinner nil))
+
+(provide 'paradox-core)
+;;; paradox-core.el ends here.
--- /dev/null
+;;; paradox-execute.el --- executing package transactions -*- lexical-binding:t -*-
+
+;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+;; Prefix: paradox
+;; Separator: -
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; 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 2
+;; 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.
+;;
+
+;;; Commentary:
+;;
+;; Functions related to executing package-menu transactions.
+;; Everything that happens when you hit `x' is in here.
+
+\f
+;;; Code:
+(require 'cl-lib)
+(require 'seq)
+
+(require 'package)
+(require 'paradox-core)
+(require 'paradox-github)
+
+(defgroup paradox-execute nil
+ "Paradox Packages Menu configurations."
+ :prefix "paradox-"
+ :package-version '(paradox . "2.0")
+ :group 'paradox)
+
+(defvar paradox--current-filter)
+\f
+;;; Customization Variables
+(defcustom paradox-execute-asynchronously 'ask
+ "Whether the install/delete/upgrade should be asynchronous.
+Possible values are:
+ t, which means always;
+ nil, which means never;
+ ask, which means ask each time."
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask each time" ask))
+ :package-version '(paradox . "2.0")
+ :group 'paradox-execute)
+
+(defcustom paradox-async-display-buffer-function #'display-buffer
+ "Function used to display *Paradox Report* buffer after asynchronous upgrade.
+Set this to nil to avoid displaying the buffer. Or set this to a
+function like `display-buffer' or `pop-to-buffer'.
+
+This is only used if `paradox-menu-execute' was given a non-nil
+NOQUERY argument. Otherwise, only a message is displayed."
+ :type '(choice (const :tag "Don't display the buffer" nil)
+ function)
+ :package-version '(paradox . "2.0")
+ :group 'paradox-execute)
+
+\f
+;;; Execution Hook
+(defvar paradox-after-execute-functions nil
+ "List of functions run after performing package transactions.
+These are run after a set of installation, deletion, or upgrades
+has been performed. Each function in this hook must take a single
+argument. An associative list of the form
+
+ ((SYMBOL . DATA) (SYMBOL . DATA) ...)
+
+This list contains the following entries, describing what
+occurred during the execution:
+
+ SYMBOL DATA
+ `installed' List of installed packages.
+ `deleted' List of deleted packages.
+ `activated' List of activated packages.
+ `error' List of errors.
+ `async' Non-nil if transaction was performed asynchronously.
+ `noquery' The NOQUERY argument given to `paradox-menu-execute'.")
+(put 'risky-local-variable-p 'paradox-after-execute-functions t)
+(mapc (lambda (x) (add-hook 'paradox-after-execute-functions x t))
+ '(paradox--activate-if-asynchronous
+ paradox--refresh-package-buffer
+ paradox--report-buffer-print
+ paradox--report-buffer-display-if-noquery
+ paradox--report-message
+ ))
+
+(defun paradox--refresh-package-buffer (_)
+ "Refresh the *Packages* buffer, if it exists."
+ (let ((buf (get-buffer "*Packages*")))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (revert-buffer)))))
+
+(defun paradox--activate-if-asynchronous (alist)
+ "Activate packages after an asynchronous operation.
+Argument ALIST describes the operation."
+ (let-alist alist
+ (when .async
+ (dolist (pkg .activated)
+ (if (fboundp 'package--list-loaded-files)
+ (package-activate-1 pkg 'reload)
+ (package-activate-1 pkg))))))
+
+(defun paradox--print-package-list (list)
+ "Print LIST at point."
+ (let* ((width (apply #'max
+ (mapcar (lambda (x) (string-width (symbol-name (package-desc-name x))))
+ list)))
+ (tabulated-list-format
+ `[("Package" ,(1+ width) nil)
+ ("Version" 0 nil)])
+ (tabulated-list-padding 2))
+ (mapc
+ (lambda (p) (tabulated-list-print-entry
+ p
+ `[,(symbol-name (package-desc-name p))
+ ,(package-version-join (package-desc-version p))]))
+ list)))
+
+(defun paradox--report-buffer-print (alist)
+ "Print a transaction report in *Package Report* buffer.
+Possibly display the buffer or message the user depending on the
+situation.
+Argument ALIST describes the operation."
+ (let-alist alist
+ (let ((buf (get-buffer-create "*Paradox Report*"))
+ (inhibit-read-only t))
+ (with-current-buffer buf
+ (goto-char (point-max))
+ ;; TODO: Write our own mode for this.
+ (special-mode)
+ (insert "\n\f\n")
+ (save-excursion
+ (insert (format-time-string "Package transaction finished. %c\n"))
+ (when .error
+ (insert "Errors:\n ")
+ (dolist (it .error)
+ (princ it (current-buffer))
+ (insert "\n"))
+ (insert "\n\n"))
+ (when .installed
+ (insert "Installed:\n")
+ (paradox--print-package-list .installed)
+ (insert "\n"))
+ (when .deleted
+ (insert "Deleted:\n")
+ (paradox--print-package-list .deleted)
+ (insert "\n")))))))
+
+(defun paradox--report-buffer-display-if-noquery (alist)
+ "Display report buffer if `paradox-execute' was called with a NOQUERY prefix.
+ALIST describes the transaction.
+`paradox-async-display-buffer-function' is used if transaction
+was asynchronous. Otherwise, `pop-to-buffer' is used."
+ (let-alist alist
+ ;; The user has never seen the packages in this transaction. So
+ ;; we display them in a buffer.
+ (when (or .noquery .error)
+ (let ((buf (get-buffer "*Paradox Report*")))
+ (when (buffer-live-p buf)
+ (cond
+ ;; If we're async, the user might be doing something else, so
+ ;; we don't steal focus.
+ ((and .async paradox-async-display-buffer-function)
+ (funcall paradox-async-display-buffer-function buf))
+ ;; If we're not async, just go ahead and pop.
+ ((or (not .async)
+ ;; If there's an error, display the buffer even if
+ ;; `paradox-async-display-buffer-function' is nil.
+ .error)
+ (pop-to-buffer buf))))))))
+
+(defun paradox--report-message (alist)
+ "Message the user about the executed transaction.
+ALIST describes the transaction."
+ (let-alist alist
+ (message "%s%s"
+ (paradox--format-message nil .installed .deleted)
+ (if (memq 'paradox--report-buffer-print paradox-after-execute-functions)
+ " See the buffer *Paradox Report* for more details." ""))
+ (when .errors
+ (message "Errors encountered during the operation: %S\n%s"
+ .errors
+ (if (memq 'paradox--report-buffer-print paradox-after-execute-functions)
+ " See the buffer *Paradox Report* for more details." "")))))
+
+\f
+;;; Execution
+(defun paradox-menu-execute (&optional noquery)
+ "Perform marked Package Menu actions.
+Packages marked for installation are downloaded and installed;
+packages marked for deletion are removed.
+
+Afterwards, if `paradox-automatically-star' is t, automatically
+star new packages, and unstar removed packages. Upgraded packages
+aren't changed.
+
+Synchronicity of the actions depends on
+`paradox-execute-asynchronously'. Optional argument NOQUERY
+non-nil means do not ask the user to confirm. If asynchronous,
+never ask anyway."
+ (interactive "P")
+ (unless (derived-mode-p 'paradox-menu-mode)
+ (error "The current buffer is not in Paradox Menu mode"))
+ (when (and (stringp paradox-github-token)
+ (eq paradox-automatically-star 'unconfigured))
+ (customize-save-variable
+ 'paradox-automatically-star
+ (y-or-n-p "When you install new packages would you like them to be automatically starred?
+\(They will be unstarred when you delete them) ")))
+ (when (and (stringp paradox--current-filter)
+ (string-match "Upgradable" paradox--current-filter))
+ (setq tabulated-list-sort-key '("Status" . nil))
+ (setq paradox--current-filter nil))
+ (paradox--menu-execute-1 noquery))
+
+(defmacro paradox--perform-package-transaction (install delete)
+ "Install all packages from INSTALL and delete those from DELETE.
+Return an alist with properties listing installed,
+deleted, and activated packages, and errors."
+ `(let (activated installed deleted errored)
+ (advice-add #'package-activate-1 :after
+ (lambda (pkg &rest _)
+ (ignore-errors (push pkg activated)))
+ '((name . paradox--track-activated)))
+ (condition-case err
+ (progn
+ (dolist (pkg ,install)
+ ;; 2nd arg introduced in 25.
+ (if (version<= "25" emacs-version)
+ (package-install pkg 'dont-select)
+ (package-install pkg))
+ (push pkg installed))
+ (let ((delete-list ,delete))
+ (dolist (pkg (if (fboundp 'package--sort-by-dependence)
+ (package--sort-by-dependence delete-list)
+ delete-list))
+ (condition-case err
+ (progn (package-delete pkg)
+ (push pkg deleted))
+ (error (push err errored))))))
+ (error (push err errored)))
+ (advice-remove #'package-activate-1 'paradox--track-activated)
+ (list (cons 'installed (nreverse installed))
+ (cons 'deleted (nreverse deleted))
+ (cons 'activated (nreverse activated))
+ (cons 'error (nreverse errored)))))
+
+(defvar paradox--current-filter)
+
+(declare-function async-inject-variables "async")
+(defun paradox--menu-execute-1 (&optional noquery)
+ "Implementation used by `paradox-menu-execute'.
+NOQUERY, if non-nil, means to execute without prompting the
+user."
+ (let ((before-alist (paradox--repo-alist))
+ install-list delete-list)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((p (point))
+ (inhibit-read-only t))
+ (while (not (eobp))
+ (let ((c (char-after)))
+ (if (eq c ?\s)
+ (forward-line 1)
+ (push (tabulated-list-get-id)
+ (pcase c
+ (`?D delete-list)
+ (`?I install-list)))
+ (delete-region p (point))
+ (forward-line 1)
+ (setq p (point)))))
+ (when (or delete-list install-list)
+ (delete-region p (point))
+ (ignore-errors
+ (set-window-start (selected-window) (point-min))))))
+ (if (not (or delete-list install-list))
+ (message "No operations specified.")
+ ;; Confirm with the user.
+ (when (or noquery
+ (y-or-n-p (paradox--format-message 'question install-list delete-list)))
+ ;; On Emacs 25, update the selected packages list.
+ (when (fboundp 'package--update-selected-packages)
+ (let-alist (package-menu--partition-transaction install-list delete-list)
+ (package--update-selected-packages .install .delete)))
+ ;; Background or foreground?
+ (if (or (not install-list)
+ (not (pcase paradox-execute-asynchronously
+ (`nil nil)
+ (`ask
+ (if noquery nil
+ (y-or-n-p "Execute in the background (see `paradox-execute-asynchronously')? ")))
+ (_ t))))
+ ;; Synchronous execution
+ (progn
+ (let ((alist (paradox--perform-package-transaction install-list delete-list)))
+ (run-hook-with-args 'paradox-after-execute-functions
+ `((noquery . ,noquery) (async . nil) ,@alist)))
+ (when (and (stringp paradox-github-token) paradox-automatically-star)
+ (paradox--post-execute-star-unstar before-alist (paradox--repo-alist))))
+ ;; Start spinning
+ (paradox--start-spinner)
+
+ ;; Async execution
+ (unless (require 'async nil t)
+ (error "For asynchronous execution please install the `async' package"))
+ ;; We have to do this with eval, because `async-start' is a
+ ;; macro and it might not have been defined at compile-time.
+ (eval
+ `(async-start
+ (lambda ()
+ (require 'package)
+ ,(async-inject-variables "\\`package-")
+ (setq package-menu-async nil)
+ (dolist (elt package-alist)
+ (package-activate (car elt) 'force))
+ (let ((alist ,(macroexpand
+ `(paradox--perform-package-transaction ',install-list ',delete-list))))
+ (list package-alist
+ (when (boundp 'package-selected-packages)
+ package-selected-packages)
+ package-archive-contents
+ ;; This is the alist that will be passed to the hook.
+ (cons '(noquery . ,noquery) (cons '(async . t) alist)))))
+ (lambda (x)
+ (setq package-alist (pop x)
+ package-selected-packages (pop x)
+ package-archive-contents (pop x))
+ (when (spinner-p paradox--spinner)
+ (spinner-stop paradox--spinner)
+ (setq paradox--spinner nil))
+ (setq paradox--executing nil)
+ (run-hook-with-args 'paradox-after-execute-functions (pop x))
+ (paradox--post-execute-star-unstar ',before-alist (paradox--repo-alist))))))))))
+
+\f
+;;; Aux functions
+(defun paradox--repo-alist ()
+ "List of known repos."
+ (delete-dups
+ (remove nil
+ (mapcar
+ (lambda (it) (gethash it paradox--package-repo-list))
+ package-alist))))
+
+(defun paradox--format-message (question-p install-list delete-list)
+ "Format a message regarding a transaction.
+If QUESTION-P is non-nil, format a question suitable for
+`y-or-n-p', otherwise format a report in the past sense.
+INSTALL-LIST and DELETE-LIST are a list of packages about to be
+installed and deleted, respectively."
+ (concat
+ (when install-list
+ (let ((len (length install-list)))
+ (format "Install%s %d package%s"
+ (if question-p "" "ed")
+ len
+ (if (> len 1) "s" ""))))
+ (when (and install-list (not delete-list))
+ (if question-p "? " "."))
+ (when (and install-list delete-list)
+ ", and ")
+ (when delete-list
+ (let ((len (length delete-list)))
+ (format "Delete%s %d package%s%s"
+ (if question-p "" "d")
+ len
+ (if (> len 1) "s" "")
+ (if question-p "? " "."))))))
+
+(defun paradox--post-execute-star-unstar (before after)
+ "Star repos in AFTER absent from BEFORE, unstar vice-versa."
+ (let ((repos (hash-table-keys paradox--user-starred-repos)))
+ (mapc #'paradox--star-repo
+ (seq-difference (seq-difference after before) repos))
+ (mapc #'paradox--unstar-repo
+ (seq-intersection (seq-difference before after) repos))))
+
+(provide 'paradox-execute)
+;;; paradox-execute.el ends here
--- /dev/null
+;;; paradox-github.el --- interacting with the Github API -*- lexical-binding:t -*-
+
+;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+;; Prefix: paradox
+;; Separator: -
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; 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 2
+;; 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.
+;;
+
+\f
+;;; Code:
+(require 'cl-lib)
+(require 'package)
+(require 'paradox-core)
+
+(defgroup paradox-github nil
+ "Paradox Github configurations."
+ :prefix "paradox-"
+ :package-version '(paradox . "2.0")
+ :group 'paradox)
+
+(defvar paradox--user-starred-list nil)
+(make-obsolete-variable
+ 'paradox--user-starred-list 'paradox--user-starred-repos "2.1")
+(defvar paradox--user-starred-repos (make-hash-table))
+
+\f
+;;; Github token
+(defcustom paradox-github-token nil
+ "Access token to use for github actions.
+Currently, that means (un)starring repos.
+
+To generate an access token:
+ 1. Visit the page https://github.com/settings/tokens/new?scopes=public_repo&description=Paradox
+ and login to github (if asked).
+ 2. Click on \"Generate Token\", copy the generated token, and
+ save it to this variable by writing
+ (setq paradox-github-token TOKEN)
+ somewhere in your configuration and evaluating it (or just
+ restart emacs).
+
+This is similar to how erc or jabber handle authentication in
+emacs, but the following disclaimer always worth reminding.
+
+DISCLAIMER
+When you save this variable, DON'T WRITE IT ANYWHERE PUBLIC. This
+token grants (very) limited access to your account.
+END DISCLAIMER
+
+One way to make this variable safer is to set it from your
+authinfo.gpg file. See this issue for instructions on how to do that:
+https://github.com/Malabarba/paradox/issues/147#issuecomment-409336111
+
+Paradox will ask you whether you want github integration the
+first time you start it. If you answer \"no\", it will remember
+your choice via `customize-save-variable'. You can do this
+manually by setting this variable to t. Setting it to nil means
+it hasn't been configured yet."
+ :type '(choice (string :tag "Token")
+ (const :tag "Disable" t)
+ (const :tag "Ask me next time" nil))
+ :group 'paradox-github
+ :package-version '(paradox . "0.2"))
+
+(defcustom paradox-automatically-star 'unconfigured
+ "When you install new packages, should they be automatically starred?
+This variable has no effect if `paradox-github-token' isn't set
+to a string.
+
+Paradox is capable of automatically starring packages when you
+install them, and unstarring when you delete them. This only
+applies to actual installation/deletion, i.e. Paradox doesn't
+auto (un)star packages that were simply upgraded.
+
+If this variable is nil, this behaviour is disabled. \\<paradox-menu-mode-map>
+
+On the Package Menu, you can always manually star packages with \\[paradox-menu-mark-star-unstar]."
+ :type '(choice (const :tag "Yes" t)
+ (const :tag "No" nil)
+ (const :tag "Ask later" unconfigured))
+ :group 'paradox-github
+ :package-version '(paradox . "0.2"))
+
+(defmacro paradox--enforce-github-token (&rest forms)
+ "If a token is defined, perform FORMS, otherwise ignore forms ask for it be defined."
+ `(if (stringp paradox-github-token)
+ (progn ,@forms)
+ (setq paradox-github-token nil)
+ (paradox--check-github-token)))
+
+(defun paradox--check-github-token ()
+ "Check that the user has either set or refused the github token.
+If neither has happened, ask the user now whether he'd like to
+configure or refuse the token."
+ (if (stringp paradox-github-token) t
+ (if paradox-github-token
+ t
+ (if (not (y-or-n-p "Would you like to set up GitHub integration?
+This will allow you to star/unstar packages from the Package Menu. "))
+ (customize-save-variable 'paradox-github-token t)
+ (describe-variable 'paradox-github-token)
+ (when (get-buffer "*Help*")
+ (switch-to-buffer "*Help*")
+ (delete-other-windows))
+ (if (y-or-n-p "Follow the instructions on the `paradox-github-token' variable.
+May I take you to the token generation page? ")
+ (browse-url "https://github.com/settings/tokens/new?scopes=public_repo&description=Paradox"))
+ (message "Once you're finished, simply call `paradox-list-packages' again.")
+ nil))))
+
+\f
+;;; Starring
+(defun paradox-star-all-installed-packages ()
+ "Star all of your currently installed packages.
+No questions asked."
+ (interactive)
+ (paradox--enforce-github-token
+ (mapc (lambda (x) (paradox--star-package-safe (car-safe x))) package-alist)))
+
+(defun paradox--starred-repo-p (repo)
+ "Non-nil if REPO is starred by the user."
+ (gethash repo paradox--user-starred-repos))
+
+(defun paradox--star-package-safe (pkg &optional delete query)
+ "Star PKG without throwing errors, unless DELETE is non-nil, then unstar.
+If QUERY is non-nil, ask the user first."
+ (let ((repo (gethash pkg paradox--package-repo-list)))
+ (when (and repo (paradox--starred-repo-p repo))
+ (paradox--star-repo repo delete query))))
+
+(defun paradox--star-repo (repo &optional delete query)
+ "Star REPO, unless DELETE is non-nil, then unstar.
+If QUERY is non-nil, ask the user first.
+
+Throws error if repo is malformed."
+ (when (or (not query)
+ (y-or-n-p (format "Really %sstar %s? "
+ (if delete "un" "") repo)))
+ (paradox--github-action-star repo delete)
+ (message "%starred %s." (if delete "Uns" "S") repo)
+ (if delete
+ (remhash repo paradox--user-starred-repos)
+ (puthash repo t paradox--user-starred-repos))))
+
+(defun paradox--unstar-repo (repo &optional delete query)
+ "Unstar REPO.
+Calls (paradox--star-repo REPO (not DELETE) QUERY)."
+ (paradox--star-repo repo (not delete) query))
+
+(defun paradox--full-name-reader ()
+ "Return all \"full_name\" properties in the buffer.
+Much faster than `json-read'."
+ (let (out)
+ (while (search-forward-regexp
+ "^ *\"full_name\" *: *\"\\(.*\\)\", *$" nil t)
+ (push (match-string-no-properties 1) out))
+ (goto-char (point-max))
+ out))
+
+(defun paradox--refresh-user-starred-list (&optional async)
+ "Fetch the user's list of starred repos."
+ (paradox--github-action "user/starred?per_page=100"
+ :async (when async 'refresh)
+ :callback (lambda (res)
+ (setq paradox--user-starred-repos
+ (make-hash-table :size (length res)
+ :test #'equal))
+ (dolist (it res)
+ (puthash it t paradox--user-starred-repos)))
+ :reader #'paradox--full-name-reader))
+
+(defun paradox--github-action-star (repo &optional delete)
+ "Call `paradox--github-action' with \"user/starred/REPO\" as the action.
+DELETE and NO-RESULT are passed on."
+ (paradox--github-action (concat "user/starred/" repo)
+ :async t
+ :method (if (stringp delete) delete
+ (if delete "DELETE" "PUT"))))
+
+\f
+;;; The Base (generic) function
+(defun paradox--github-report (&rest text)
+ "Write TEXT to the *Paradox Github* buffer."
+ (with-current-buffer (get-buffer-create "*Paradox Report*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (apply #'insert text))
+ (goto-char (point-min))))
+
+(defun paradox--github-error (format &rest args)
+ "Throw an error using FORMAT and ARGS.
+Also print contents of current buffer to *Paradox Github*."
+ (declare (indent 1))
+ (paradox--github-report (buffer-string))
+ (apply #'error
+ (concat format " See *Paradox Github* buffer for the full result")
+ args))
+
+(defvar paradox--github-errors-to-ignore nil
+ "List of numbers to ignore when parsing the HTML return code.
+`paradox--github-parse-response-code' normally returns nil on
+200, t on 204, and emits messages or errors on other values.
+Adding values to this list makes them be treated as a 200.")
+
+(defun paradox--github-parse-response-code ()
+ "Non-nil if this reponse buffer looks ok.
+Leave point at the return code on the first line."
+ (goto-char (point-min))
+ (unless (search-forward " " nil t)
+ (paradox--github-report (buffer-string))
+ (error "Tried contacting Github, but I can't understand the result. See *Paradox Github* buffer for the full result"))
+ (pcase (thing-at-point 'number)
+ ((pred (lambda (n) (member n paradox--github-errors-to-ignore))) nil)
+ (`204 nil) ;; OK, but no content.
+ (`200 t) ;; OK, with content.
+ ;; I'll implement redirection if anyone ever reports this.
+ ;; For now, I haven't found a place where it's used.
+ ((or `301 `302 `303 `304 `305 `306 `307)
+ (paradox--github-report "Redirect received:\n\n" (buffer-string))
+ ;; (message "Received a redirect reply, please file a bug report (M-x `paradox-bug-report')")
+ nil)
+ ((or `404) ;; Not found.
+ (paradox--github-report (buffer-string))
+ (message "This repo doesn't seem to exist, Github replied with: %s"
+ (substring (thing-at-point 'line) 0 -1))
+ nil)
+ ((or `403) ;; Forbidden
+ (paradox--github-error
+ "Github wouldn't let me do this - does your token have the right permissions? They're here: https://github.com/settings/tokens"))
+ ((or `400 `422) ;; Bad request.
+ (paradox--github-error
+ "Github didn't understand my request, please file a bug report (M-x `paradox-bug-report')"))
+ (`401 (paradox--github-error
+ (if (stringp paradox-github-token)
+ "Github says you're not authenticated, try creating a new Github token"
+ "Github says you're not authenticated, you need to configure `paradox-github-token'")))
+ (_ (paradox--github-error "Github returned: %S"
+ (substring (thing-at-point 'line) 0 -1)))))
+
+(defvar paradox--github-next-page nil)
+
+(defun paradox--https-proxy ()
+ "Get https proxy if url-proxy-services has been defined."
+ (if (and (boundp 'url-proxy-services)
+ (assoc "https" url-proxy-services))
+ (cdr (assoc "https" url-proxy-services))
+ ""))
+
+(defmacro paradox--with-github-buffer (method action async unwind-form
+ &rest body)
+ "Run BODY in a Github request buffer.
+UNWIND-FORM is run no matter what, and doesn't affect the return
+value."
+ (declare (indent 4)
+ (debug t))
+ (let ((call-name (make-symbol "callback")))
+ `(let ((,call-name
+ (lambda (&optional process event)
+ (cond
+ ((or (not event)
+ (string-match "\\`finished" event))
+ (with-current-buffer (if (processp process)
+ (process-buffer process)
+ (current-buffer))
+ (unwind-protect
+ (when (paradox--github-parse-response-code)
+ (let ((next-page))
+ (when (search-forward-regexp
+ "^Link: .*<\\([^>]+\\)>; rel=\"next\"" nil t)
+ (setq next-page (match-string-no-properties 1))
+ (setq paradox--github-next-page next-page))
+ (ignore next-page)
+ (search-forward-regexp "^\r?$")
+ (skip-chars-forward "[:blank:]\n\r")
+ (delete-region (point-min) (point))
+ ,@body))
+ ,unwind-form
+ (kill-buffer (current-buffer)))))
+ ((string-match "\\`exited abnormally" event)
+ ,unwind-form
+ (paradox--github-report (buffer-string))
+ (message "async curl command %s\n method: %s\n action: %s"
+ event ,method ,action))))))
+ (if ,async
+ (condition-case nil
+ (set-process-sentinel
+ (apply #'start-process "paradox-github"
+ (generate-new-buffer "*Paradox http*")
+ "curl"
+ "-x" (paradox-https-proxy)
+ "-s" "-i" "-d" "" "-X" ,method ,action
+ (when (stringp paradox-github-token)
+ (list "-u" (concat paradox-github-token ":x-oauth-basic"))))
+ ,call-name)
+ (error ,unwind-form))
+ (with-temp-buffer
+ ;; Make the request.
+ (condition-case nil
+ (apply #'call-process
+ "curl" nil t nil
+ "-x" (paradox--https-proxy)
+ "-s" "-i" "-d" "" "-X" ,method ,action
+ (when (stringp paradox-github-token)
+ (list "-u" (concat paradox-github-token ":x-oauth-basic"))))
+ (error ,unwind-form))
+ ;; Do the processing.
+ (funcall ,call-name))))))
+
+(cl-defun paradox--github-action (action &key
+ (method "GET")
+ reader
+ max-pages
+ (callback #'identity)
+ async)
+ "Contact the github api performing ACTION with METHOD.
+Default METHOD is \"GET\".
+
+Action can be anything such as \"user/starred?per_page=100\". If
+it's not a full url, it will be prepended with
+\"https://api.github.com/\". The action might not work if
+`paradox-github-token' isn't set.
+
+This function also handles the pagination used in github results,
+results of each page are appended together. Use MAX-PAGES to
+limit the number of pages that are fetched.
+
+Return value is always a list.
+- If READER is nil, the result of the action is completely
+ ignored (no pagination is performed on this case, making it
+ much faster).
+- Otherwise, READER is called as a function with point right
+ after the headers and should always return a list. As a special
+ exception, if READER is t, it is equivalent to a function that
+ returns (t).
+
+CALLBACK, if provided, is a function to be called with the read
+data as an argument. If the request succeeds with no data, it
+will be given nil as an argument. Its return value is returned by
+this function.
+
+ASYNC determines to run the command asynchronously. In this case,
+the function's return value is undefined. In particular, if ASYNC
+is the symbol refresh, it means the package-menu should be
+refreshed after the operation is done."
+ (declare (indent 1))
+ ;; Make sure the token's configured.
+ (unless (string-match "\\`https?://" action)
+ (setq action (concat "https://api.github.com/" action)))
+ (let ((do-update (when (eq async 'refresh)
+ (make-symbol "paradox-github"))))
+ (when do-update
+ (add-to-list 'package--downloads-in-progress do-update))
+ (paradox--with-github-buffer method action async
+ (paradox--update-downloads-in-progress
+ do-update)
+ (cond
+ ((not reader)
+ (funcall callback nil))
+ ((or (not next-page)
+ (and max-pages (< max-pages 2)))
+ (funcall callback
+ (unless (eobp) (funcall reader))))
+ (t
+ (let ((result (unless (eobp) (funcall reader))))
+ (paradox--github-action next-page
+ :method method
+ :reader reader
+ :async async
+ :max-pages (when max-pages (1- max-pages))
+ :callback (lambda (res)
+ (funcall callback
+ (append result res))))))))))
+
+(provide 'paradox-github)
+;;; paradox-github.el ends here
--- /dev/null
+;;; paradox-menu.el --- defining the Packages menu -*- lexical-binding:t -*-
+
+;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+
+;; Author: Artur Malabarba <bruce.connor.amNOSPAMgmail.com>
+;; Prefix: paradox
+;; Separator: -
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; 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 2
+;; 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.
+;;
+
+;;; Code:
+(require 'cl-lib)
+(require 'cus-edit)
+(require 'package)
+(require 'subr-x)
+(require 'hydra)
+
+(require 'paradox-core)
+(require 'paradox-github)
+(require 'paradox-commit-list)
+(require 'paradox-execute)
+
+(defgroup paradox-menu nil
+ "Paradox Packages Menu configurations."
+ :prefix "paradox-"
+ :package-version '(paradox . "2.0")
+ :group 'paradox)
+
+\f
+;;; Customization Variables
+(defcustom paradox-column-width-package 18
+ "Width of the \"Package\" column."
+ :type 'integer
+ :group 'paradox-menu
+ :package-version '(paradox . "0.1"))
+
+(defcustom paradox-column-width-version 9
+ "Width of the \"Version\" column."
+ :type 'integer
+ :group 'paradox-menu
+ :package-version '(paradox . "0.1"))
+
+(defcustom paradox-column-width-status 10
+ "Width of the \"Status\" column."
+ :type 'integer
+ :group 'paradox-menu
+ :package-version '(paradox . "0.1"))
+
+(defcustom paradox-column-width-star 4
+ "Width of the \"Star\" column."
+ :type 'integer
+ :group 'paradox-menu
+ :package-version '(paradox . "0.1"))
+
+(defcustom paradox-column-width-download 4
+ "Width of the \"Download Count\" column."
+ :type 'integer
+ :group 'paradox-menu
+ :package-version '(paradox . "1.1"))
+
+(defcustom paradox-display-star-count t
+ "If non-nil, adds a \"Star\" column to the Package Menu."
+ :type 'boolean
+ :group 'paradox-menu
+ :package-version '(paradox . "1.1"))
+
+(defcustom paradox-display-download-count nil
+ "If non-nil, adds a \"Download\" column to the Package Menu."
+ :type 'boolean
+ :group 'paradox-menu
+ :package-version '(paradox . "1.2.3"))
+
+(defface paradox-mode-line-face
+ '((t :inherit (font-lock-keyword-face mode-line-buffer-id)
+ :weight normal))
+ "Face used on mode line statuses."
+ :group 'paradox)
+(defface paradox-name-face
+ '((t :inherit link))
+ "Face used on the package's name."
+ :group 'paradox)
+(defface paradox-homepage-button-face
+ '((t :underline t :inherit font-lock-comment-face))
+ "Face used on the homepage button."
+ :group 'paradox)
+;; (defface paradox-version-face
+;; '((t :inherit default))
+;; "Face used on the version column."
+;; :group 'paradox)
+(defface paradox-archive-face
+ '((t :inherit paradox-comment-face))
+ "Face used on the archive column."
+ :group 'paradox)
+(defface paradox-star-face
+ '((t :inherit font-lock-string-face))
+ "Face used on the star column, for packages you haven't starred."
+ :group 'paradox)
+(defface paradox-starred-face
+ '((t :inherit font-lock-variable-name-face))
+ "Face used on the star column, for packages you have starred."
+ :group 'paradox)
+(defface paradox-download-face
+ '((t :inherit font-lock-keyword-face))
+ "Face used on the Downloads column."
+ :group 'paradox)
+(defface paradox-description-face
+ '((t :inherit default))
+ "Face used on the description column.
+If `paradox-lines-per-entry' > 1, the face
+`paradox-description-face-multiline' is used instead."
+ :group 'paradox)
+(defface paradox-description-face-multiline
+ '((t :inherit font-lock-doc-face))
+ "Face used on the description column when `paradox-lines-per-entry' > 1.
+If `paradox-lines-per-entry' = 1, the face
+`paradox-description-face' is used instead."
+ :group 'paradox)
+
+(defcustom paradox-status-face-alist
+ '(("built-in" . font-lock-builtin-face)
+ ("available" . default)
+ ("new" . bold)
+ ("held" . font-lock-constant-face)
+ ("disabled" . font-lock-warning-face)
+ ("avail-obso" . font-lock-comment-face)
+ ("installed" . font-lock-comment-face)
+ ("dependency" . font-lock-comment-face)
+ ("incompat" . font-lock-comment-face)
+ ("deleted" . font-lock-comment-face)
+ ("unsigned" . font-lock-warning-face))
+ "List of (\"STATUS\" . FACE) cons cells.
+When displaying the package menu, FACE will be used to paint the
+Version, Status, and Description columns of each package whose
+status is STATUS."
+ :type '(repeat (cons string face))
+ :group 'paradox-menu
+ :package-version '(paradox . "2.0"))
+
+(defcustom paradox-homepage-button-string "h"
+ "String used to for the link that takes you to a package's homepage."
+ :type 'string
+ :group 'paradox-menu
+ :package-version '(paradox . "0.10"))
+
+(defcustom paradox-use-homepage-buttons t
+ "If non-nil a button will be added after the name of each package.
+This button takes you to the package's homepage."
+ :type 'boolean
+ :group 'paradox-menu
+ :package-version '(paradox . "0.10"))
+
+(defcustom paradox-lines-per-entry 1
+ "Number of lines used to display each entry in the Package Menu.
+1 Gives you the regular package menu.
+2 Displays the description on a separate line below the entry.
+3+ Adds empty lines separating the entries."
+ :type 'integer
+ :group 'paradox-menu
+ :package-version '(paradox . "0.10"))
+
+\f
+;;; Internal
+(defvar-local paradox--current-filter nil)
+
+(defvar paradox--column-name-star
+ (if (char-displayable-p ?\x2605) "\x2605" "*"))
+
+(defvar paradox--column-name-download
+ (if (char-displayable-p ?\x2193) "\x2193" "DC"))
+
+(defvar paradox--upgradeable-packages nil)
+(defvar paradox--upgradeable-packages-number nil)
+(defvar paradox--upgradeable-packages-any? nil)
+
+(defvar paradox--column-index-star nil)
+(defvar paradox--column-index-download nil)
+
+(defvar paradox--desc-suffix nil)
+(defvar paradox--desc-prefix nil)
+
+(defvar paradox--commit-list-buffer "*Package Commit List*")
+
+(define-button-type 'paradox-name
+ 'action #'package-menu-describe-package
+ 'follow-link t)
+
+(define-button-type 'paradox-homepage
+ 'action #'paradox-menu-visit-homepage
+ 'follow-link t
+ 'mouse-face 'custom-button-mouse)
+
+;; Use `font-lock-face' on creation instead.
+(button-type-put 'paradox-name 'face nil)
+(button-type-put 'paradox-homepage 'face nil)
+
+\f
+;;; Building the packages buffer.
+(defun paradox-refresh-upgradeable-packages ()
+ "Refresh the list of upgradeable packages."
+ (interactive)
+ (setq paradox--upgradeable-packages (package-menu--find-upgrades))
+ (setq paradox--upgradeable-packages-number
+ (length paradox--upgradeable-packages))
+ (setq paradox--upgradeable-packages-any?
+ (> paradox--upgradeable-packages-number 0)))
+
+(defun paradox--print-info (pkg)
+ "Return a package entry suitable for `tabulated-list-entries'.
+PKG has the form (PKG-DESC . STATUS).
+Return (PKG-DESC [STAR NAME VERSION STATUS DOC])."
+ (let* ((pkg-desc (if (consp pkg) (car pkg) pkg))
+ (status (if (consp pkg) (cdr pkg) (package-desc-status pkg)))
+ (face (or (cdr (assoc-string status paradox-status-face-alist))
+ 'font-lock-warning-face))
+ (url (paradox--package-homepage pkg-desc))
+ (name (symbol-name (package-desc-name pkg-desc)))
+ (name-length (length name))
+ (counts (paradox--count-print (package-desc-name pkg-desc)))
+ (button-length (if paradox-use-homepage-buttons (length paradox-homepage-button-string) 0)))
+ (paradox--incf status)
+ (let ((cell (assq :stars (package-desc-extras pkg-desc))))
+ (if cell
+ (setcdr cell counts)
+ (push (cons :stars counts) (package-desc-extras pkg-desc))))
+ (list pkg-desc
+ `[,(concat
+ (make-text-button
+ (truncate-string-to-width
+ name (- paradox-column-width-package button-length) 0 nil t)
+ nil
+ 'type 'paradox-name
+ 'font-lock-face 'paradox-name-face
+ 'help-echo (concat "Package: " name)
+ 'package-desc pkg-desc)
+ (when (and paradox-use-homepage-buttons url)
+ (make-string (max 0 (- paradox-column-width-package name-length button-length)) ?\s))
+ (when (and paradox-use-homepage-buttons url)
+ (make-text-button
+ (copy-sequence paradox-homepage-button-string) nil
+ 'type 'paradox-homepage
+ 'font-lock-face 'paradox-homepage-button-face
+ 'help-echo (format "Visit %s" url))))
+ ,(propertize (package-version-join
+ (package-desc-version pkg-desc))
+ 'font-lock-face face)
+ ,(propertize status 'font-lock-face face)
+ ,@(if (cdr package-archives)
+ (list (propertize (or (package-desc-archive pkg-desc) "")
+ 'font-lock-face 'paradox-archive-face)))
+ ,@counts
+ ,(propertize
+ (concat (propertize " " 'display paradox--desc-prefix)
+ (package-desc-summary pkg-desc)
+ (propertize " " 'display paradox--desc-suffix)) ;└╰
+ 'font-lock-face
+ (if (> paradox-lines-per-entry 1)
+ 'paradox-description-face-multiline
+ 'paradox-description-face))])))
+
+(defun paradox--count-print (pkg)
+ "Return counts of PKG as a package-desc list."
+ (append
+ (when (and paradox-display-star-count (hash-table-p paradox--star-count))
+ (list (paradox--package-star-count pkg)))
+ (when (and paradox-display-download-count (hash-table-p paradox--download-count))
+ (list (paradox--package-download-count pkg)))))
+
+(defun paradox--package-download-count (pkg)
+ "Return propertized string with the download count of PKG."
+ (let ((c (gethash pkg paradox--download-count nil)))
+ (propertize
+ (if (numberp c)
+ (if (> c 999) (format "%sK" (truncate c 1000)) (format "%s" c))
+ " ")
+ 'font-lock-face 'paradox-download-face
+ 'value (or c 0))))
+
+(defun paradox--package-homepage (pkg)
+ "PKG can be the package-name symbol or a package-desc object."
+ (let* ((object (if (symbolp pkg) (cadr (assoc pkg package-archive-contents)) pkg))
+ (name (if (symbolp pkg) pkg (package-desc-name pkg)))
+ (extras (package-desc-extras object))
+ (homepage (and (listp extras) (cdr-safe (assoc :url extras)))))
+ (or homepage
+ (and (setq extras (gethash name paradox--package-repo-list))
+ (format "https://github.com/%s" extras)))))
+
+(defun paradox--get-or-return-package (pkg)
+ "Take a marker or package name PKG and return a package name."
+ (if (or (markerp pkg) (null pkg))
+ (if (derived-mode-p 'package-menu-mode)
+ (package-desc-name (tabulated-list-get-id))
+ (error "Not in Package Menu"))
+ pkg))
+
+(defun paradox--incf (status)
+ "Increment the count for STATUS on `paradox--package-count'.
+Also increments the count for \"total\"."
+ (paradox--inc-count status)
+ (unless (member status '("obsolete" "avail-obso" "incompat"))
+ (paradox--inc-count "total")))
+
+(defun paradox--inc-count (string)
+ "Increment the cdr of (assoc-string STRING paradox--package-count)."
+ (let ((cons (assoc-string string paradox--package-count)))
+ (setcdr cons (1+ (cdr cons)))))
+
+(defun paradox--entry-star-count (entry)
+ "Get the star count of the package in ENTRY."
+ (paradox--package-star-count
+ ;; The package symbol should be in the ID field, but that's not mandatory,
+ (or (ignore-errors (elt (car entry) 1))
+ ;; So we also try interning the package name.
+ (intern (car (elt (cadr entry) 0))))))
+
+(defun paradox--handle-failed-download (&rest _)
+ "Handle the case when Emacs fails to download Github data."
+ (paradox--update-downloads-in-progress 'paradox--data)
+ (unless (hash-table-p paradox--download-count)
+ (setq paradox--download-count (make-hash-table)))
+ (unless (hash-table-p paradox--package-repo-list)
+ (setq paradox--package-repo-list (make-hash-table)))
+ (unless (hash-table-p paradox--star-count)
+ (setq paradox--star-count (make-hash-table)))
+ (unless (hash-table-p paradox--wiki-packages)
+ (setq paradox--wiki-packages (make-hash-table)))
+ (message "[Paradox] Error downloading Github data"))
+
+(defmacro paradox--with-work-buffer (location file &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+This is the same as `package--with-work-buffer-async', except it
+automatically decides whether to download asynchronously based on
+`package-menu-async'."
+ (declare (indent 2) (debug t))
+ (require 'package)
+ (if (fboundp 'package--with-response-buffer)
+ `(package--with-response-buffer
+ ,location :file ,file
+ :async package-menu-async
+ :error-form (paradox--handle-failed-download)
+ ,@body
+ (paradox--update-downloads-in-progress 'paradox--data))
+ `(package--with-work-buffer ,location ,file ,@body)))
+
+(defun paradox--refresh-remote-data ()
+ "Download metadata and populate the respective variables."
+ (interactive)
+ (when (boundp 'package--downloads-in-progress)
+ (add-to-list 'package--downloads-in-progress 'paradox--data))
+ (condition-case-unless-debug nil
+ (paradox--with-work-buffer paradox--data-url "data-hashtables"
+ (setq paradox--star-count (read (current-buffer)))
+ (setq paradox--package-repo-list (read (current-buffer)))
+ (setq paradox--download-count (read (current-buffer)))
+ (setq paradox--wiki-packages (read (current-buffer))))
+ (error (paradox--handle-failed-download))))
+
+(defun paradox--package-star-count (package)
+ "Get the star count of PACKAGE."
+ (let ((count (gethash package paradox--star-count nil))
+ (repo (gethash package paradox--package-repo-list nil)))
+ (propertize
+ (format "%s" (or count ""))
+ 'font-lock-face
+ (if (and repo (paradox--starred-repo-p repo))
+ 'paradox-starred-face
+ 'paradox-star-face))))
+
+(defun paradox--star-predicate (A B)
+ "Non-nil t if star count of A is larger than B."
+ (> (string-to-number (elt (cadr A) paradox--column-index-star))
+ (string-to-number (elt (cadr B) paradox--column-index-star))))
+(defun paradox--download-predicate (A B)
+ "Non-nil t if download count of A is larger than B."
+ (> (get-text-property 0 'value (elt (cadr A) paradox--column-index-download))
+ (get-text-property 0 'value (elt (cadr B) paradox--column-index-download))))
+
+(defun paradox--generate-menu (remember-pos packages &optional keywords)
+ "Populate the Package Menu, without hacking into the header-format.
+If REMEMBER-POS is non-nil, keep point on the same entry.
+PACKAGES should be t, which means to display all known packages,
+or a list of package names (symbols) to display.
+
+With KEYWORDS given, only packages with those keywords are
+shown."
+ (paradox-menu--refresh packages keywords)
+ (setq paradox--current-filter
+ (if keywords (mapconcat 'identity keywords ",")
+ nil))
+ (let ((idx (paradox--column-index "Package")))
+ (when (integerp idx)
+ (setcar (elt tabulated-list-format idx)
+ (if keywords
+ (concat "Package[" paradox--current-filter "]")
+ "Package"))))
+ (tabulated-list-print remember-pos)
+ (tabulated-list-init-header)
+ (paradox--update-mode-line))
+
+(defcustom paradox-hide-wiki-packages nil
+ "If non-nil, don't display packages from the emacswiki."
+ :type 'boolean)
+
+(defun paradox--maybe-remove-wiki-packages (pkgs)
+ "Remove wiki packages from PKGS.
+If `paradox-hide-wiki-packages' is nil, just return PKGS."
+ (if (not paradox-hide-wiki-packages)
+ pkgs
+ (remq nil
+ (mapcar
+ (lambda (entry)
+ (let ((name (or (car-safe entry) entry)))
+ (unless (gethash name paradox--wiki-packages)
+ name)))
+ (if (or (not pkgs) (eq t pkgs))
+ package-archive-contents
+ pkgs)))))
+
+(defun paradox-menu--refresh (&optional packages keywords)
+ "Call `package-menu--refresh' retaining current filter.
+PACKAGES and KEYWORDS are passed to `package-menu--refresh'. If
+KEYWORDS is nil and `paradox--current-filter' is non-nil, it is
+used to define keywords."
+ (mapc (lambda (x) (setf (cdr x) 0)) paradox--package-count)
+ (let ((paradox--desc-prefix (if (> paradox-lines-per-entry 1) " \n " ""))
+ (paradox--desc-suffix (make-string (max 0 (- paradox-lines-per-entry 2)) ?\n)))
+ (cond
+ ((or packages keywords (not paradox--current-filter))
+ (package-menu--refresh
+ (paradox--maybe-remove-wiki-packages packages)
+ keywords)
+ (paradox-refresh-upgradeable-packages))
+ ((string= paradox--current-filter "Upgradable")
+ (paradox-refresh-upgradeable-packages)
+ (paradox-filter-upgrades))
+ ((string= paradox--current-filter "Starred")
+ (paradox-filter-stars)
+ (paradox-refresh-upgradeable-packages))
+ ((string-match "\\`Regexp:\\(.*\\)\\'" paradox--current-filter)
+ (paradox-filter-regexp (match-string 1 paradox--current-filter))
+ (paradox-refresh-upgradeable-packages))
+ (t
+ (paradox-menu--refresh
+ packages (split-string paradox--current-filter ","))))))
+
+(defun paradox--column-index (regexp)
+ "Find the index of the column that matches REGEXP."
+ (cl-position (format "\\`%s\\'" (regexp-quote regexp)) tabulated-list-format
+ :test (lambda (x y) (string-match x (or (car-safe y) "")))))
+
+(defun paradox--count-format ()
+ "List of star/download counts to be used as part of the entry."
+ (remove
+ nil
+ (list
+ (when paradox-display-star-count
+ (list paradox--column-name-star paradox-column-width-star
+ 'paradox--star-predicate :right-align t))
+ (when paradox-display-download-count
+ (list paradox--column-name-download paradox-column-width-download
+ 'paradox--download-predicate :right-align t)))))
+
+(defun paradox--archive-format ()
+ "List containing archive to be used as part of the entry."
+ (when (cdr package-archives)
+ (list (list "Archive"
+ (apply 'max (mapcar 'length (mapcar 'car package-archives)))
+ 'package-menu--archive-predicate))))
+
+(add-hook 'paradox-menu-mode-hook 'paradox-refresh-upgradeable-packages)
+
+\f
+;;; Mode Definition
+(define-derived-mode paradox-menu-mode tabulated-list-mode "Paradox Menu"
+ "Major mode for browsing a list of packages.
+Letters do not insert themselves; instead, they are commands.
+\\<paradox-menu-mode-map>
+\\{paradox-menu-mode-map}"
+ (hl-line-mode 1)
+ (when (boundp 'package--post-download-archives-hook)
+ (add-hook 'package--post-download-archives-hook
+ #'paradox--stop-spinner))
+ (if (boundp 'package--downloads-in-progress)
+ (setq mode-line-process
+ '("" (package--downloads-in-progress
+ (":Loading "
+ (paradox--spinner
+ (:eval (spinner-print paradox--spinner))
+ (:eval (paradox--start-spinner))))
+ (paradox--spinner
+ (":Executing " (:eval (spinner-print paradox--spinner)))))))
+ (setq mode-line-process
+ '(paradox--spinner
+ (":Executing " (:eval (spinner-print paradox--spinner))))))
+ (paradox--update-mode-line)
+ (setq tabulated-list-format
+ `[("Package" ,paradox-column-width-package package-menu--name-predicate)
+ ("Version" ,paradox-column-width-version paradox--version-predicate)
+ ("Status" ,paradox-column-width-status package-menu--status-predicate)
+ ,@(paradox--archive-format)
+ ,@(paradox--count-format)
+ ("Description" 0 nil)])
+ (setq paradox--column-index-star
+ (paradox--column-index paradox--column-name-star))
+ (setq paradox--column-index-download
+ (paradox--column-index paradox--column-name-download))
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key (cons "Status" nil))
+ (add-hook 'tabulated-list-revert-hook #'paradox-menu--refresh nil t)
+ (add-hook 'tabulated-list-revert-hook #'paradox-refresh-upgradeable-packages nil t)
+ ;; (add-hook 'tabulated-list-revert-hook #'paradox--refresh-remote-data nil t)
+ (add-hook 'tabulated-list-revert-hook #'paradox--update-mode-line 'append t)
+ (tabulated-list-init-header)
+ ;; We need package-menu-mode to be our parent, otherwise some
+ ;; commands throw errors. But we can't actually derive from it,
+ ;; otherwise its initialization will screw up the header-format. So
+ ;; we "patch" it like this.
+ (put 'paradox-menu-mode 'derived-mode-parent 'package-menu-mode)
+ (run-hooks 'package-menu-mode-hook))
+
+(put 'paradox-menu-mode 'derived-mode-parent 'package-menu-mode)
+
+(defun paradox--define-sort (name &optional key)
+ "Define sorting by column NAME and bind it to KEY.
+Defines a function called paradox-sort-by-NAME."
+ (let ((symb (intern (format "paradox-sort-by-%s" (downcase name))))
+ (key (or key (substring name 0 1))))
+ (eval
+ `(progn
+ (defun ,symb
+ (invert)
+ ,(format "Sort Package Menu by the %s column." name)
+ (interactive "P")
+ (when invert
+ (setq tabulated-list-sort-key (cons ,name nil)))
+ (tabulated-list--sort-by-column-name ,name))
+ (define-key paradox-menu-mode-map ,(concat "S" (upcase key)) ',symb)
+ (define-key paradox-menu-mode-map ,(concat "S" (downcase key)) ',symb)))))
+
+(paradox--define-sort "Package")
+(paradox--define-sort "Status")
+(paradox--define-sort paradox--column-name-star "*")
+(paradox--define-sort "Version")
+(declare-function paradox-sort-by-package "paradox-menu")
+(declare-function paradox-sort-by-version "paradox-menu")
+
+(defun paradox--version-predicate (package-a package-b)
+ "Predicate for sorting by the Version column.
+Versions are compared semantically in descending order."
+ (let ((a (package-desc-version (car package-a)))
+ (b (package-desc-version (car package-b))))
+ (cond ((version-list-= a b)
+ (package-menu--name-predicate package-a package-b))
+ (t
+ (version-list-< b a)))))
+
+(defalias 'paradox-filter-clear #'package-show-package-list
+ "Clear current Package filter.
+Redisplay the Packages buffer listing all packages, without
+fetching the list.")
+
+(defmacro paradox--apply-filter (name packages &optional nil-message)
+ "Apply filter called NAME (a string) listing only PACKAGES.
+PACKAGES should be a list of symbols (the names of packages to
+display) or a list of cons cells whose `car's are symbols.
+NIL-MESSAGE is the message to show if PACKAGES is nil, and
+defaults to: \"No %s packages\"."
+ (declare (debug t)
+ (indent 1))
+ (let* ((n (format "%s" name))
+ (cn (capitalize n))
+ (dn (downcase n)))
+ (macroexp-let2 macroexp-copyable-p pl packages
+ `(if (null ,pl)
+ (user-error ,(or nil-message (format "No %s packages." dn)))
+ (package-show-package-list
+ (mapcar (lambda (p) (or (car-safe p) p)) ,pl))
+ (setq paradox--current-filter ,cn)))))
+
+(defun paradox-filter-upgrades ()
+ "Show only upgradable packages."
+ (interactive)
+ (paradox--apply-filter Upgradable
+ paradox--upgradeable-packages)
+ (paradox-sort-by-package nil))
+
+(defun paradox-filter-stars ()
+ "Show only starred packages."
+ (interactive)
+ (let ((list))
+ (maphash (lambda (pkg repo)
+ (when (paradox--starred-repo-p repo)
+ (push pkg list)))
+ paradox--package-repo-list)
+ (paradox--apply-filter Starred list)))
+
+(defun paradox-filter-regexp (regexp)
+ "Show only packages matching REGEXP.
+Test match against name and summary."
+ (interactive (list (read-regexp "Enter Regular Expression: ")))
+ (paradox--apply-filter Regexp
+ (cl-remove-if-not
+ (lambda (package)
+ (or (string-match-p regexp (symbol-name (car package)))
+ (string-match-p regexp (package-desc-summary (cadr package)))))
+ package-archive-contents)
+ "No packages match this regexp.")
+ (setq paradox--current-filter (concat "Regexp:" regexp)))
+
+(set-keymap-parent paradox-menu-mode-map package-menu-mode-map)
+(define-key paradox-menu-mode-map "q" #'paradox-quit-and-close)
+(define-key paradox-menu-mode-map "p" #'paradox-previous-entry)
+(define-key paradox-menu-mode-map "n" #'paradox-next-entry)
+(define-key paradox-menu-mode-map "k" #'paradox-previous-describe)
+(define-key paradox-menu-mode-map "j" #'paradox-next-describe)
+(define-key paradox-menu-mode-map "s" #'paradox-menu-mark-star-unstar)
+(define-key paradox-menu-mode-map "h" #'paradox-menu-quick-help)
+(define-key paradox-menu-mode-map "v" #'paradox-menu-visit-homepage)
+(define-key paradox-menu-mode-map "w" #'paradox-menu-copy-homepage-as-kill)
+(define-key paradox-menu-mode-map "l" #'paradox-menu-view-commit-list)
+(define-key paradox-menu-mode-map "x" #'paradox-menu-execute)
+(define-key paradox-menu-mode-map "\r" #'paradox-push-button)
+(define-key paradox-menu-mode-map "F" 'package-menu-filter)
+(if (version< emacs-version "25")
+ (defhydra hydra-paradox-filter (:color blue :hint nil)
+ "
+Filter by:
+_u_pgrades _r_egexp _k_eyword _s_tarred _c_lear
+"
+ ("f" package-menu-filter)
+ ("k" package-menu-filter)
+ ("r" paradox-filter-regexp)
+ ("u" paradox-filter-upgrades)
+ ("s" paradox-filter-stars)
+ ("c" paradox-filter-clear)
+ ("g" paradox-filter-clear)
+ ("q" nil "cancel" :color blue))
+ (defhydra hydra-paradox-filter (:color blue :hint nil)
+ "
+Filter by:
+_u_pgrades _r_egexp _k_eyword _s_tarred _c_lear
+Archive: g_n_u _o_ther
+Status: _i_nstalled _a_vailable _d_ependency _b_uilt-in
+"
+ ("f" package-menu-filter)
+ ("k" package-menu-filter)
+ ("n" (package-menu-filter "arc:gnu"))
+ ("o" (package-menu-filter
+ (remove "arc:gnu"
+ (mapcar (lambda (e) (concat "arc:" (car e)))
+ package-archives))))
+ ("r" paradox-filter-regexp)
+ ("u" paradox-filter-upgrades)
+ ("s" paradox-filter-stars)
+ ("i" (package-menu-filter "status:installed"))
+ ("a" (package-menu-filter "status:available"))
+ ("b" (package-menu-filter "status:built-in"))
+ ("d" (package-menu-filter "status:dependency"))
+ ("c" paradox-filter-clear)
+ ("g" paradox-filter-clear)
+ ("q" nil "cancel" :color blue)))
+(define-key paradox-menu-mode-map "f" #'hydra-paradox-filter/body)
+
+;;; for those who don't want a hydra
+(defvar paradox--filter-map)
+(define-prefix-command 'paradox--filter-map)
+(define-key paradox--filter-map "k" #'package-menu-filter)
+(define-key paradox--filter-map "f" #'package-menu-filter)
+(define-key paradox--filter-map "r" #'paradox-filter-regexp)
+(define-key paradox--filter-map "u" #'paradox-filter-upgrades)
+(define-key paradox--filter-map "s" #'paradox-filter-stars)
+(define-key paradox--filter-map "c" #'paradox-filter-clear)
+
+(easy-menu-define paradox-menu-mode-menu paradox-menu-mode-map
+ "Menu for `paradox-menu-mode'."
+ `("Paradox"
+ ["Describe Package" package-menu-describe-package :help "Display information about this package"]
+ ["Help" paradox-menu-quick-help :help "Show short key binding help for package-menu-mode"]
+
+ "--"
+ ["Refresh Package List" package-menu-refresh
+ :help "Redownload the ELPA archive"
+ :active (not package--downloads-in-progress)]
+ ["Execute Marked Actions" paradox-menu-execute :help "Perform all the marked actions"]
+ ["Mark All Available Upgrades" package-menu-mark-upgrades
+ :help "Mark packages that have a newer version for upgrading"
+ :active (not package--downloads-in-progress)]
+
+ ("Other Mark Actions"
+ ["Mark All Obsolete for Deletion" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion"]
+ ["Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line"]
+ ["Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line"]
+ ["Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line"])
+
+ "--"
+ ("Github" :visible (stringp paradox-github-token)
+ ["Star or unstar this package" paradox-menu-mark-star-unstar]
+ ["Star all installed packages" paradox-star-all-installed-packages]
+ ["Star packages when installing" (customize-save-variable 'paradox-automatically-star (not paradox-automatically-star))
+ :help "Automatically star packages that you install (and unstar packages you delete)"
+ :style toggle :selected paradox-automatically-star])
+ ["Configure Github Inegration" (paradox--check-github-token) :visible (not paradox-github-token)]
+ ["View Changelog" paradox-menu-view-commit-list :help "Show a package's commit list on Github"]
+ ["Visit Homepage" paradox-menu-visit-homepage :help "Visit a package's Homepage on a browser"]
+
+ "--"
+ ("Filter Package List"
+ ["Clear filter" paradox-filter-clear :help "Go back to unfiltered list"]
+ ["By Keyword" package-menu-filter :help "Filter by package keyword"]
+ ["By Upgrades" paradox-filter-upgrades :help "List only upgradeable packages"]
+ ["By Regexp" paradox-filter-regexp :help "Filter packages matching a regexp"]
+ ["By Starred" paradox-filter-stars :help "List only packages starred by the user"])
+ ("Sort Package List"
+ ["By Package Name" paradox-sort-by-package]
+ ["By Status (default)" paradox-sort-by-status]
+ ["By Number of Stars" paradox-sort-by-★]
+ ["By Version" paradox-sort-by-version])
+ ["Hide by Regexp" package-menu-hide-package :help "Permanently hide all packages matching a regexp"]
+ ["Display Older Versions" package-menu-toggle-hiding
+ :style toggle :selected (not package-menu--hide-packages)
+ :help "Display package even if a newer version is already installed"]
+
+ "--"
+ ["Quit" quit-window :help "Quit package selection"]
+ ["Customize" (customize-group 'package)]))
+
+\f
+;;; Menu Mode Commands
+(defun paradox-previous-entry (&optional n)
+ "Move to previous entry, which might not be the previous line.
+With prefix N, move to the N-th previous entry."
+ (interactive "p")
+ (paradox-next-entry (- (prefix-numeric-value n)))
+ (forward-line 0)
+ (forward-button 1))
+
+(defun paradox-next-entry (&optional n)
+ "Move to next entry, which might not be the next line.
+With prefix N, move to the N-th next entry."
+ (interactive "p")
+ (setq n (prefix-numeric-value n))
+ (let ((d (cl-signum n)))
+ (dotimes (_ (abs n))
+ (forward-line (max d 0))
+ (if (eobp) (forward-line -1))
+ (forward-button d))))
+
+(defun paradox-next-describe (&optional n)
+ "Move to the next package and describe it.
+With prefix N, move to the N-th next package instead."
+ (interactive "p")
+ (paradox-next-entry n)
+ (call-interactively 'package-menu-describe-package))
+
+(defun paradox-previous-describe (&optional n)
+ "Move to the previous package and describe it.
+With prefix N, move to the N-th previous package instead."
+ (interactive "p")
+ (paradox-previous-entry n)
+ (call-interactively 'package-menu-describe-package))
+
+(defun paradox-push-button ()
+ "Push button under point, or describe package."
+ (interactive)
+ (or (push-button)
+ (call-interactively #'package-menu-describe-package)))
+
+(defvar paradox--key-descriptors
+ '(("next," "previous," "install," "delete," ("execute," . 1) "refresh," "help")
+ ("star," "visit homepage," "unmark," ("mark Upgrades," . 5) "~delete obsolete")
+ ("list commits")
+ ("filter by" "+" "upgrades" "regexp" "keyword" "starred" "clear")
+ ("Sort by" "+" "Package name" "Status" "*(star)")))
+
+(defun paradox-menu-quick-help ()
+ "Show short key binding help for `paradox-menu-mode'.
+The full list of keys can be viewed with \\[describe-mode]."
+ (interactive)
+ (message (mapconcat 'paradox--prettify-key-descriptor
+ paradox--key-descriptors "\n")))
+
+(defun paradox-quit-and-close (kill)
+ "Bury this buffer and close the window.
+With prefix KILL, kill the buffer instead of burying."
+ (interactive "P")
+ (let ((log (get-buffer-window paradox--commit-list-buffer)))
+ (when (window-live-p log)
+ (quit-window kill log))
+ (quit-window kill)))
+
+(defun paradox-menu-visit-homepage (pkg)
+ "Visit the homepage of package named PKG.
+PKG is a symbol. Interactively it is the package under point."
+ (interactive '(nil))
+ (let ((url (paradox--package-homepage
+ (paradox--get-or-return-package pkg))))
+ (if (stringp url)
+ (browse-url url)
+ (message "Package %s has no homepage."
+ (propertize (symbol-name pkg)
+ 'face 'font-lock-keyword-face)))))
+
+(defun paradox-menu-copy-homepage-as-kill (pkg)
+ "Save the homepage of package named PKG as kill.
+PKG is a symbol. Interactively it is the package under point."
+ (interactive '(nil))
+ (let ((url (paradox--package-homepage
+ (paradox--get-or-return-package pkg))))
+ (if (stringp url)
+ (progn (kill-new url)
+ (message "copied \"%s\"" url))
+ (message "Package %s has no homepage."
+ (propertize (symbol-name pkg)
+ 'face 'font-lock-keyword-face)))))
+
+(defun paradox-menu-mark-star-unstar ()
+ "Star or unstar a package and move to the next line."
+ (interactive)
+ (paradox--enforce-github-token
+ (unless paradox--user-starred-repos
+ (paradox--refresh-user-starred-list))
+ ;; Get package name
+ (let* ((pkg (paradox--get-or-return-package nil))
+ (repo (gethash pkg paradox--package-repo-list))
+ will-delete)
+ (unless pkg (error "Couldn't find package-name for this entry"))
+ ;; (Un)Star repo
+ (if (not repo)
+ (message "This package is not a GitHub repo.")
+ (setq will-delete (paradox--starred-repo-p repo))
+ (paradox--star-repo repo will-delete)
+ (cl-incf (gethash pkg paradox--star-count 0)
+ (if will-delete -1 1))
+ (tabulated-list-set-col paradox--column-name-star
+ (paradox--package-star-count pkg)))))
+ (forward-line 1))
+
+(defun paradox-menu-view-commit-list (pkg)
+ "Visit the commit list of package named PKG.
+PKG is a symbol. Interactively it is the package under point."
+ (interactive '(nil))
+ (let* ((name (paradox--get-or-return-package pkg))
+ (repo (gethash name paradox--package-repo-list)))
+ (if repo
+ (with-selected-window
+ (display-buffer (get-buffer-create paradox--commit-list-buffer))
+ (paradox-commit-list-mode)
+ (setq paradox--package-repo repo)
+ (setq paradox--package-name name)
+ (setq paradox--package-version
+ (paradox--get-installed-version name))
+ (setq paradox--package-tag-commit-alist
+ (paradox--get-tag-commit-alist repo))
+ (paradox--commit-list-update-entries)
+ (tabulated-list-print))
+ (message "Package %s is not a GitHub repo." pkg))))
+
+\f
+;;; Mode-line Construction
+(defcustom paradox-local-variables
+ '(mode-line-mule-info
+ mode-line-client
+ mode-line-remote mode-line-position
+ column-number-mode size-indication-mode)
+ "Variables which will take special values on the Packages buffer.
+This is a list, where each element is either SYMBOL or (SYMBOL . VALUE).
+
+Each SYMBOL (if it is bound) will be locally set to VALUE (or
+nil) on the Packages buffer."
+ :type '(repeat (choice symbol (cons symbol sexp)))
+ :group 'paradox-menu
+ :package-version '(paradox . "0.1"))
+
+(defcustom paradox-display-buffer-name nil
+ "If nil, *Packages* buffer name won't be displayed in the mode-line."
+ :type 'boolean
+ :group 'paradox-menu
+ :package-version '(paradox . "0.2"))
+
+(defun paradox--build-buffer-id (st n)
+ "Return a list that propertizes ST and N for the mode-line."
+ `((:propertize ,st
+ face paradox-mode-line-face)
+ (:propertize ,(int-to-string n)
+ face mode-line-buffer-id)))
+
+(defun paradox--update-mode-line ()
+ "Update `mode-line-format'."
+ (mapc #'paradox--set-local-value paradox-local-variables)
+ (let ((total-lines (int-to-string (length tabulated-list-entries))))
+ (paradox--update-mode-line-front-space total-lines)
+ (paradox--update-mode-line-buffer-identification total-lines)))
+
+(defun paradox--update-mode-line-buffer-identification (_total-lines)
+ "Update `mode-line-buffer-identification'.
+TOTAL-LINES is currently unused."
+ (require 'spinner)
+ (setq mode-line-buffer-identification
+ `((paradox-display-buffer-name
+ ,(propertized-buffer-identification
+ (format "%%%sb" (length (buffer-name)))))
+ (paradox--current-filter (:propertize ("[" paradox--current-filter "]") face paradox-mode-line-face))
+ (paradox--upgradeable-packages-any?
+ (:eval (paradox--build-buffer-id " Upgrade:" paradox--upgradeable-packages-number)))
+ (package-menu--new-package-list
+ (:eval (paradox--build-buffer-id " New:" (paradox--cas "new"))))
+ ,(paradox--build-buffer-id " Installed:" (+ (paradox--cas "installed")
+ (paradox--cas "dependency")
+ (paradox--cas "unsigned")))
+ (paradox--current-filter
+ "" ,(paradox--build-buffer-id " Total:" (length package-archive-contents))))))
+
+(defvar sml/col-number)
+(defvar sml/numbers-separator)
+(defvar sml/col-number-format)
+(defvar sml/line-number-format)
+(defvar sml/position-construct)
+(declare-function sml/compile-position-construct "sml")
+(defvar sml/post-id-separator)
+(defun paradox--update-mode-line-front-space (total-lines)
+ "Update `mode-line-front-space'.
+TOTAL-LINES is the number of lines in the buffer."
+ (if (memq 'sml/post-id-separator mode-line-format)
+ (progn
+ (add-to-list (make-local-variable 'mode-line-front-space)
+ (propertize " (" 'face 'sml/col-number))
+ (setq column-number-mode line-number-mode)
+ (set (make-local-variable 'sml/numbers-separator) "")
+ (set (make-local-variable 'sml/col-number-format)
+ (format "/%s)" total-lines))
+ (set (make-local-variable 'sml/line-number-format)
+ (format "%%%sl" (length total-lines)))
+ (make-local-variable 'sml/position-construct)
+ (sml/compile-position-construct))
+ (set (make-local-variable 'mode-line-front-space)
+ `(line-number-mode
+ ("(" (:propertize ,(format "%%%sl" (length total-lines)) face mode-line-buffer-id) "/"
+ ,total-lines ")")))
+ (set (make-local-variable 'mode-line-modified) nil)))
+
+(defun paradox--set-local-value (x)
+ "Locally set value of (car X) to (cdr X)."
+ (let ((sym (or (car-safe x) x)))
+ (when (boundp sym)
+ (set (make-local-variable sym) (cdr-safe x)))))
+
+(defun paradox--prettify-key-descriptor (desc)
+ "Prettify DESC to be displayed as a help menu."
+ (if (listp desc)
+ (if (listp (cdr desc))
+ (mapconcat 'paradox--prettify-key-descriptor desc " ")
+ (let ((place (cdr desc))
+ (out (car desc)))
+ (setq out (propertize out 'face 'paradox-comment-face))
+ (add-text-properties place (1+ place) '(face paradox-highlight-face) out)
+ out))
+ (paradox--prettify-key-descriptor (cons desc 0))))
+
+(provide 'paradox-menu)
+;;; paradox-menu.el ends here
--- /dev/null
+(define-package "paradox" "20191011.1111" "A modern Packages Menu. Colored, with package ratings, and customizable."
+ '((emacs "24.4")
+ (seq "1.7")
+ (let-alist "1.0.3")
+ (spinner "1.7.3")
+ (hydra "0.13.2"))
+ :keywords
+ '("package" "packages")
+ :authors
+ '(("Artur Malabarba" . "emacsNOSPAMendlessparentheses.com"))
+ :maintainer
+ '("Artur Malabarba" . "emacsNOSPAMendlessparentheses.com")
+ :url "https://github.com/Malabarba/paradox")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; paradox.el --- A modern Packages Menu. Colored, with package ratings, and customizable. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2014-2015 Artur Malabarba <emacsNOSPAMendlessparentheses.com>
+
+;; Author: Artur Malabarba <emacsNOSPAMendlessparentheses.com>
+;; URL: https://github.com/Malabarba/paradox
+;; Version: 2.5.4
+;; Keywords: package packages
+;; Package-Requires: ((emacs "24.4") (seq "1.7") (let-alist "1.0.3") (spinner "1.7.3") (hydra "0.13.2"))
+;; Prefix: paradox
+;; Separator: -
+
+;;; Commentary:
+;;
+;; Paradox can be installed from Melpa with M-x `package-install' RET
+;; paradox.
+;; It can also be installed manually in the usual way, just be mindful of
+;; the dependencies.
+;;
+;; To use it, simply call M-x `paradox-list-packages' (instead of the
+;; regular `list-packages').
+;; This will give you most features out of the box. If you want to be
+;; able to star packages as well, just configure the
+;; `paradox-github-token' variable then call `paradox-list-packages'
+;; again.
+;;
+;; If you'd like to stop using Paradox, you may call `paradox-disable'
+;; and go back to using the regular `list-packages'.
+;;
+;; ## Current Features ##
+;;
+;; ### Several Improvements ###
+;;
+;; Paradox implements many small improvements to the package menu
+;; itself. They all work out of the box and are completely customizable!
+;; *(Also, hit `h' to see all keys.)*
+;;
+;; * Visit the package's homepage with `v' (or just use the provided buttons).
+;; * Shortcuts for package filtering:
+;; * <f r> filters by regexp (`occur');
+;; * <f u> display only packages with upgrades;
+;; * <f k> filters by keyword.
+;; * `hl-line-mode' enabled by default.
+;; * Display useful information on the mode-line and cleanup a bunch of
+;; useless stuff.
+;; * **Customization!** Just call M-x `paradox-customize' to see what you can
+;; do.
+;; * Customize column widths.
+;; * Customize faces (`paradox-star-face', `paradox-status-face-alist' and `paradox-archive-face').
+;; * Customize local variables.
+;;
+;; ### Package Ratings ###
+;;
+;; Paradox also integrates with
+;; **GitHub Stars**, which works as **rough** package rating system.
+;; That is, Paradox package menu will:
+;;
+;; 1. Display the number of GitHub Stars each package has (assuming it's
+;; in a github repo, of course);
+;; 2. Possibly automatically star packages you install, and unstar
+;; packages you delete (you will be asked the first time whether you
+;; want this);
+;; 3. Let you star and unstar packages by hitting the `s' key;
+;; 4. Let you star all packages you have installed with M-x `paradox-star-all-installed-packages'.
+;;
+;; Item **1.** will work out of the box, the other items obviously
+;; require a github account (Paradox will help you generate a token the
+;; first time you call `paradox-list-packages').
+;;
+;; ## How Star Displaying Works ##
+;;
+;; We generate a map of Package Name -> Repository from
+;; [Melpa](https://github.com/milkypostman/melpa.git)'s `recipe'
+;; directory, some repos may correspond to more than one package.
+;; This map is used count the stars a given package has.
+;; _This doesn't mean you need Melpa to see the star counts, the numbers
+;; will be displayed regardless of what archives you use._
+;;
+;; Currently, packages that are not hosted on GitHub are listed with a
+;; blank star count, which is clearly different from 0-star packages
+;; (which are displayed with a 0, obviously).
+;; If you know of an alternative that could be used for these packages,
+;; [open an issue](https://github.com/Bruce-Connor/paradox/issues/new)
+;; here, I'd love to hear.
+
+;;; License:
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; 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 2
+;; 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.
+
+\f
+;;; Code:
+
+(require 'package)
+(require 'cl-lib)
+
+(require 'paradox-core)
+(require 'paradox-execute)
+(require 'paradox-menu)
+
+(defconst paradox-version "2.5.4" "Version of the paradox.el package.")
+(defun paradox-bug-report ()
+ "Opens github issues page in a web browser. Please send any bugs you find.
+Please include your Emacs and paradox versions."
+ (interactive)
+ (message "Your paradox-version is: %s, and your emacs version is: %s.\nPlease include this in your report!"
+ paradox-version emacs-version)
+ (browse-url "https://github.com/Bruce-Connor/paradox/issues/new"))
+(defun paradox-customize ()
+ "Open the customization menu in the `paradox' group."
+ (interactive)
+ (customize-group 'paradox t))
+(defgroup paradox nil
+ "Customization group for paradox."
+ :prefix "paradox-"
+ :group 'emacs
+ :package-version '(paradox . "0.1"))
+
+\f
+;;; External Commands
+;;;###autoload
+(defun paradox-list-packages (no-fetch)
+ "Improved version of `package-list-packages'. The heart of Paradox.
+Function is equivalent to `package-list-packages' (including the
+prefix NO-FETCH), but the resulting Package Menu is improved in
+several ways.
+
+Among them:
+
+1. Uses `paradox-menu-mode', which has more functionality and
+keybinds than `package-menu-mode'.
+
+2. Uses some font-locking to improve readability.
+
+3. Optionally shows the number GitHub stars and Melpa downloads
+for packages.
+
+4. Adds useful information in the mode-line."
+ (interactive "P")
+ (when (paradox--check-github-token)
+ (paradox-enable)
+ (let ((is-25 (fboundp 'package--with-response-buffer)))
+ (unless no-fetch
+ (unless is-25
+ (paradox--refresh-remote-data)))
+ (package-list-packages no-fetch)
+ (unless no-fetch
+ (when is-25
+ (add-to-list 'package--downloads-in-progress 'paradox--data)
+ (paradox--refresh-remote-data))
+ (when (stringp paradox-github-token)
+ (paradox--refresh-user-starred-list
+ (bound-and-true-p package-menu-async)))))))
+
+;;;###autoload
+(defun paradox-upgrade-packages (&optional no-fetch)
+ "Upgrade all packages. No questions asked.
+This function is equivalent to `list-packages', followed by a
+`package-menu-mark-upgrades' and a `package-menu-execute'. Except
+the user isn't asked to confirm deletion of packages.
+
+If `paradox-execute-asynchronously' is non-nil, part of this
+operation may be performed in the background.
+
+The NO-FETCH prefix argument is passed to `list-packages'. It
+prevents re-download of information about new versions. It does
+not prevent downloading the actual packages (obviously)."
+ (interactive "P")
+ (save-window-excursion
+ (let ((package-menu-async nil))
+ (paradox-list-packages no-fetch))
+ (package-menu-mark-upgrades)
+ (paradox-menu-execute 'noquery)))
+
+;;;###autoload
+(defun paradox-enable ()
+ "Enable paradox, overriding the default package-menu."
+ (interactive)
+ (when (and (fboundp 'package--update-downloads-in-progress)
+ (not (fboundp 'package--with-response-buffer)))
+ (message "[Paradox] Your Emacs snapshot is outdated, please install a more recent one.")
+ (setq package-menu-async nil))
+ (paradox--override-definition 'package-menu--print-info 'paradox--print-info)
+ (when (fboundp 'package-menu--print-info-simple)
+ (paradox--override-definition 'package-menu--print-info-simple 'paradox--print-info))
+ (paradox--override-definition 'package-menu--generate 'paradox--generate-menu)
+ ;; Tough it may not look like it, this is totally necessary too.
+ (paradox--override-definition 'package-menu-mode 'paradox-menu-mode)
+ (paradox--core-enable))
+
+;;;###autoload
+(defun paradox-require (feature &optional filename noerror package refresh)
+ "Like `require', but also install FEATURE if it is absent.
+FILENAME is passed to `require'.
+If NOERROR is non-nil, don't complain if the feature couldn't be
+installed, just return nil.
+
+- If FEATURE is present, `require' it and return t.
+
+- If FEATURE is not present, install PACKAGE with `package-install'.
+If PACKAGE is nil, assume FEATURE is the package name.
+After installation, `require' FEATURE.
+
+By default, the current package database is only updated if it is
+empty. Passing a non-nil REFRESH argument forces this update."
+ (or (require feature filename t)
+ (let ((package (or package
+ (if (stringp feature)
+ (intern feature)
+ feature))))
+ (require 'package)
+ (unless (and package-archive-contents (null refresh))
+ (package-refresh-contents))
+ (and (condition-case e
+ (package-install package)
+ (error (if noerror nil (error (cadr e)))))
+ (require feature filename noerror)))))
+
+(provide 'paradox)
+;;; paradox.el ends here
projects / emacsconfig.git / commitdiff