156 lines
5.5 KiB
EmacsLisp
156 lines
5.5 KiB
EmacsLisp
;;; paradox-core.el --- common functions -*- lexical-binding:t -*-
|
||
|
||
;; Copyright (C) 2014-2015 Artur Malabarba <bruce.connor.am@gmail.com>
|
||
|
||
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
|
||
;; Prefix: paradox
|
||
;; Separator: -
|
||
|
||
;;; License:
|
||
;;
|
||
;; This file is NOT part of GNU Emacs.
|
||
;;
|
||
;; This program is free software; you can redistribute it and/or
|
||
;; modify it under the terms of the GNU General Public License
|
||
;; as published by the Free Software Foundation; either version 2
|
||
;; of the License, or (at your option) any later version.
|
||
;;
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
;;
|
||
|
||
;;; Code:
|
||
(require 'subr-x)
|
||
|
||
|
||
;;; 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
|
||
(declare-function paradox--update-downloads-in-progress "paradox-menu")
|
||
(if (fboundp 'package--update-downloads-in-progress)
|
||
(defun paradox--update-downloads-in-progress (&optional name)
|
||
(when name
|
||
(package--update-downloads-in-progress name)))
|
||
(defalias 'paradox--update-downloads-in-progress #'ignore))
|
||
(define-obsolete-function-alias
|
||
'paradox--pdate-downloads-in-progress
|
||
'paradox--update-downloads-in-progress
|
||
"2.1")
|
||
|
||
|
||
;;; 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.
|