From: Andreas Gerler Date: Thu, 23 Nov 2023 18:59:20 +0000 (+0100) Subject: update paradox X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=b14c076ebff3ea1ac6fee83648cb2cac8471780b;p=emacsconfig.git update paradox Signed-off-by: Andreas Gerler --- diff --git a/elpa/paradox-20191011.1111/paradox-autoloads.el b/elpa/paradox-20191011.1111/paradox-autoloads.el deleted file mode 100644 index ea0ef147..00000000 --- a/elpa/paradox-20191011.1111/paradox-autoloads.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; paradox-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) - -;;;### (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) - -;;;*** - -;;;### (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)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; paradox-autoloads.el ends here diff --git a/elpa/paradox-20191011.1111/paradox-commit-list.el b/elpa/paradox-20191011.1111/paradox-commit-list.el deleted file mode 100644 index a03b9ce7..00000000 --- a/elpa/paradox-20191011.1111/paradox-commit-list.el +++ /dev/null @@ -1,240 +0,0 @@ -;;; paradox-commit-list.el --- listing commits for a package's repository -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2015 Artur Malabarba - -;; Author: Artur Malabarba -;; 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) -(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) - - -;;; 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) - - -;;; 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) - - -;;; 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))) - - -;;; 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))))) - - -;;; 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}" - (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 " " #'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. diff --git a/elpa/paradox-20191011.1111/paradox-core.el b/elpa/paradox-20191011.1111/paradox-core.el deleted file mode 100644 index 0a043f5c..00000000 --- a/elpa/paradox-20191011.1111/paradox-core.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; paradox-core.el --- common functions -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2015 Artur Malabarba - -;; Author: Artur Malabarba -;; 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) - - -;;; 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) - - -;;; 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) - - -;;; 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))) - - -;;; 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") - - -;;; 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. diff --git a/elpa/paradox-20191011.1111/paradox-execute.el b/elpa/paradox-20191011.1111/paradox-execute.el deleted file mode 100644 index a4cba8ae..00000000 --- a/elpa/paradox-20191011.1111/paradox-execute.el +++ /dev/null @@ -1,393 +0,0 @@ -;;; paradox-execute.el --- executing package transactions -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2015 Artur Malabarba - -;; Author: Artur Malabarba -;; 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. - - -;;; 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) - -;;; 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) - - -;;; 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 \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." ""))))) - - -;;; 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)))))))))) - - -;;; 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 diff --git a/elpa/paradox-20191011.1111/paradox-github.el b/elpa/paradox-20191011.1111/paradox-github.el deleted file mode 100644 index b1aae113..00000000 --- a/elpa/paradox-20191011.1111/paradox-github.el +++ /dev/null @@ -1,389 +0,0 @@ -;;; paradox-github.el --- interacting with the Github API -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2015 Artur Malabarba - -;; Author: Artur Malabarba -;; 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 '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)) - - -;;; 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. \\ - -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)))) - - -;;; 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")))) - - -;;; 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 diff --git a/elpa/paradox-20191011.1111/paradox-menu.el b/elpa/paradox-20191011.1111/paradox-menu.el deleted file mode 100644 index 550d92e7..00000000 --- a/elpa/paradox-20191011.1111/paradox-menu.el +++ /dev/null @@ -1,973 +0,0 @@ -;;; paradox-menu.el --- defining the Packages menu -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2015 Artur Malabarba - -;; Author: Artur Malabarba -;; 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) - - -;;; 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")) - - -;;; 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) - - -;;; 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) - - -;;; 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}" - (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)])) - - -;;; 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)))) - - -;;; 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 diff --git a/elpa/paradox-20191011.1111/paradox-pkg.el b/elpa/paradox-20191011.1111/paradox-pkg.el deleted file mode 100644 index dc49617a..00000000 --- a/elpa/paradox-20191011.1111/paradox-pkg.el +++ /dev/null @@ -1,16 +0,0 @@ -(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" . "emacs@endlessparentheses.com")) - :maintainer - '("Artur Malabarba" . "emacs@endlessparentheses.com") - :url "https://github.com/Malabarba/paradox") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/paradox-20191011.1111/paradox.el b/elpa/paradox-20191011.1111/paradox.el deleted file mode 100644 index 7f3c5475..00000000 --- a/elpa/paradox-20191011.1111/paradox.el +++ /dev/null @@ -1,229 +0,0 @@ -;;; paradox.el --- A modern Packages Menu. Colored, with package ratings, and customizable. -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2015 Artur Malabarba - -;; Author: Artur Malabarba -;; 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: -;; * filters by regexp (`occur'); -;; * display only packages with upgrades; -;; * 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. - - -;;; 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")) - - -;;; 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 diff --git a/elpa/paradox-20191011.1119/paradox-autoloads.el b/elpa/paradox-20191011.1119/paradox-autoloads.el new file mode 100644 index 00000000..1c1dd843 --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox-autoloads.el @@ -0,0 +1,119 @@ +;;; paradox-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (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-enable "paradox" "\ +Enable paradox, overriding the default package-menu." 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) + +(register-definition-prefixes "paradox" '("paradox-")) + +;;;*** + +;;;### (autoloads nil "paradox-commit-list" "paradox-commit-list.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from paradox-commit-list.el + +(register-definition-prefixes "paradox-commit-list" '("paradox-")) + +;;;*** + +;;;### (autoloads nil "paradox-core" "paradox-core.el" (0 0 0 0)) +;;; Generated autoloads from paradox-core.el + +(register-definition-prefixes "paradox-core" '("paradox-")) + +;;;*** + +;;;### (autoloads nil "paradox-execute" "paradox-execute.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from paradox-execute.el + +(register-definition-prefixes "paradox-execute" '("paradox-")) + +;;;*** + +;;;### (autoloads nil "paradox-github" "paradox-github.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from paradox-github.el + +(register-definition-prefixes "paradox-github" '("paradox-")) + +;;;*** + +;;;### (autoloads nil "paradox-menu" "paradox-menu.el" (0 0 0 0)) +;;; Generated autoloads from paradox-menu.el + +(register-definition-prefixes "paradox-menu" '("paradox-")) + +;;;*** + +;;;### (autoloads nil nil ("paradox-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; paradox-autoloads.el ends here diff --git a/elpa/paradox-20191011.1119/paradox-commit-list.el b/elpa/paradox-20191011.1119/paradox-commit-list.el new file mode 100644 index 00000000..a03b9ce7 --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox-commit-list.el @@ -0,0 +1,240 @@ +;;; paradox-commit-list.el --- listing commits for a package's repository -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2015 Artur Malabarba + +;; Author: Artur Malabarba +;; 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) +(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) + + +;;; 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) + + +;;; 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) + + +;;; 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))) + + +;;; 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))))) + + +;;; 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}" + (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 " " #'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. diff --git a/elpa/paradox-20191011.1119/paradox-core.el b/elpa/paradox-20191011.1119/paradox-core.el new file mode 100644 index 00000000..0a043f5c --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox-core.el @@ -0,0 +1,155 @@ +;;; paradox-core.el --- common functions -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2015 Artur Malabarba + +;; Author: Artur Malabarba +;; 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) + + +;;; 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) + + +;;; 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) + + +;;; 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))) + + +;;; 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") + + +;;; 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. diff --git a/elpa/paradox-20191011.1119/paradox-execute.el b/elpa/paradox-20191011.1119/paradox-execute.el new file mode 100644 index 00000000..a4cba8ae --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox-execute.el @@ -0,0 +1,393 @@ +;;; paradox-execute.el --- executing package transactions -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2015 Artur Malabarba + +;; Author: Artur Malabarba +;; 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. + + +;;; 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) + +;;; 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) + + +;;; 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 \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." ""))))) + + +;;; 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)))))))))) + + +;;; 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 diff --git a/elpa/paradox-20191011.1119/paradox-github.el b/elpa/paradox-20191011.1119/paradox-github.el new file mode 100644 index 00000000..b1aae113 --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox-github.el @@ -0,0 +1,389 @@ +;;; paradox-github.el --- interacting with the Github API -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2015 Artur Malabarba + +;; Author: Artur Malabarba +;; 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 '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)) + + +;;; 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. \\ + +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)))) + + +;;; 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")))) + + +;;; 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 diff --git a/elpa/paradox-20191011.1119/paradox-menu.el b/elpa/paradox-20191011.1119/paradox-menu.el new file mode 100644 index 00000000..550d92e7 --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox-menu.el @@ -0,0 +1,973 @@ +;;; paradox-menu.el --- defining the Packages menu -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2015 Artur Malabarba + +;; Author: Artur Malabarba +;; 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) + + +;;; 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")) + + +;;; 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) + + +;;; 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) + + +;;; 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}" + (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)])) + + +;;; 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)))) + + +;;; 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 diff --git a/elpa/paradox-20191011.1119/paradox-pkg.el b/elpa/paradox-20191011.1119/paradox-pkg.el new file mode 100644 index 00000000..4a795d56 --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox-pkg.el @@ -0,0 +1,18 @@ +(define-package "paradox" "20191011.1119" "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")) + :commit "96401577ed02f433debe7604e49afd478e9eda61" :authors + '(("Artur Malabarba" . "emacs@endlessparentheses.com")) + :maintainers + '(("Artur Malabarba" . "emacs@endlessparentheses.com")) + :maintainer + '("Artur Malabarba" . "emacs@endlessparentheses.com") + :keywords + '("package" "packages") + :url "https://github.com/Malabarba/paradox") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/paradox-20191011.1119/paradox.el b/elpa/paradox-20191011.1119/paradox.el new file mode 100644 index 00000000..88809db7 --- /dev/null +++ b/elpa/paradox-20191011.1119/paradox.el @@ -0,0 +1,229 @@ +;;; paradox.el --- A modern Packages Menu. Colored, with package ratings, and customizable. -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2015 Artur Malabarba + +;; Author: Artur Malabarba +;; URL: https://github.com/Malabarba/paradox +;; Version: 2.5.5 +;; 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: +;; * filters by regexp (`occur'); +;; * display only packages with upgrades; +;; * 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. + + +;;; 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")) + + +;;; 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