235 lines
8.4 KiB
EmacsLisp
235 lines
8.4 KiB
EmacsLisp
;;; paradox-commit-list.el --- listing commits for a package's repository -*- 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)
|
||
(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.")
|
||
|
||
|
||
;;; Functions
|
||
(defun paradox--get-tag-commit-alist (repo)
|
||
"Get REPO's tag list and associate them to commit hashes."
|
||
(require 'json)
|
||
(mapcar
|
||
(lambda (x)
|
||
(cons
|
||
(cdr (assoc 'sha (cdr (assoc 'commit x))))
|
||
(cdr (assoc 'name x))))
|
||
(let ((json-array-type 'list))
|
||
(paradox--github-action
|
||
(format "repos/%s/tags?per_page=100" repo)
|
||
:reader #'json-read
|
||
:max-pages paradox-commit-list-query-max-pages))))
|
||
|
||
(defun paradox--get-installed-version (pkg)
|
||
"Return the installed version of PKG.
|
||
- If PKG isn't installed, return '(0).
|
||
- If it has a Melpa-like version (YYYYMMDD HHMM), return it as a
|
||
time value.
|
||
- If it has a regular version number, return it as a string."
|
||
(let ((desc (cadr (assoc pkg package-alist))))
|
||
(if desc
|
||
(let ((version (package-desc-version desc)))
|
||
(if (> (car version) 19000000)
|
||
(date-to-time
|
||
(format "%8dT%02d:%02d"
|
||
(car version)
|
||
(/ (cadr version) 100)
|
||
(% (cadr version) 100)))
|
||
;; Regular version numbers.
|
||
(mapconcat 'int-to-string version ".")))
|
||
'(0 0))))
|
||
|
||
(defun paradox--commit-tabulated-list (repo)
|
||
"Return the tabulated list for REPO's commit list."
|
||
(require 'json)
|
||
(let* ((paradox--commit-message-face nil)
|
||
(json-array-type 'list)
|
||
(feed (paradox--github-action
|
||
(format "repos/%s/commits?per_page=100" repo)
|
||
:reader #'json-read
|
||
:max-pages paradox-commit-list-query-max-pages)))
|
||
(apply 'append (mapcar 'paradox--commit-print-info feed))))
|
||
|
||
(defun paradox--commit-print-info (x)
|
||
"Parse json in X into a tabulated list entry."
|
||
(let* ((commit (cdr (assoc 'commit x)))
|
||
(date (date-to-time (cdr (assoc 'date (cdr (assoc 'committer commit))))))
|
||
(title (split-string (cdr (assoc 'message commit)) "[\n\r][ \t]*" t))
|
||
;; (url (cdr (assoc 'html_url commit)))
|
||
(cc (cdr (assoc 'comment_count commit)))
|
||
(sha (cdr (assoc 'sha x)))
|
||
(tag (cdr (assoc-string sha paradox--package-tag-commit-alist))))
|
||
;; Have we already crossed the installed commit, or is it not even installed?
|
||
(unless (or paradox--commit-message-face
|
||
(equal '(0) paradox--package-version))
|
||
;; Is this where we cross to old commits?
|
||
(when (paradox--version<= date tag)
|
||
(setq paradox--commit-message-face 'paradox-comment-face)))
|
||
;; Return the tabulated list entry.
|
||
(cons
|
||
;; The ID
|
||
(list `((is-old . ,(null paradox--commit-message-face))
|
||
(lisp-date . ,date)
|
||
,@x)
|
||
;; The actual displayed data
|
||
(vector
|
||
(propertize (format-time-string paradox-date-format date)
|
||
'button t
|
||
'follow-link t
|
||
'action 'paradox-commit-list-visit-commit
|
||
'face (or paradox--commit-message-face 'link))
|
||
(concat (if (> cc 0)
|
||
(propertize (format "(%s comments) " cc)
|
||
'face 'font-lock-function-name-face)
|
||
"")
|
||
(if (stringp tag)
|
||
(propertize tag 'face 'paradox-commit-tag-face)
|
||
"")
|
||
(if (stringp tag) " " "")
|
||
(propertize (or (car-safe title) "")
|
||
'face paradox--commit-message-face))))
|
||
(mapcar (lambda (m) (list x (vector "" (propertize m 'face paradox--commit-message-face))))
|
||
(cdr title)))))
|
||
|
||
(defun paradox--version<= (date version)
|
||
"Non-nil if commit at DATE tagged with VERSION is older or equal to `paradox--package-version'."
|
||
;; Melpa date-like versions
|
||
(if (listp paradox--package-version)
|
||
;; Installed date >= to commit date
|
||
(null (time-less-p paradox--package-version date))
|
||
;; Regular version numbers.
|
||
(and version
|
||
(ignore-errors (version<= version paradox--package-version)))))
|
||
|
||
(defun paradox--commit-list-update-entries ()
|
||
"Update entries of current commit-list."
|
||
(setq tabulated-list-entries
|
||
(paradox--commit-tabulated-list paradox--package-repo)))
|
||
|
||
|
||
;;; 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>
|
||
\\{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.
|