From efef6fb5853905d72019d4da71d3da87f280eec1 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Mon, 7 Jan 2019 14:48:16 +0100 Subject: [PATCH] add magit-todos. Signed-off-by: Andreas Gerler --- bba.org | 7 + .../magit-todos-autoloads.el | 48 + .../magit-todos-pkg.el | 2 + elpa/magit-todos-20181220.458/magit-todos.el | 1147 +++++++++++++++++ elpa/magit-todos-readme.txt | 3 + 5 files changed, 1207 insertions(+) create mode 100644 elpa/magit-todos-20181220.458/magit-todos-autoloads.el create mode 100644 elpa/magit-todos-20181220.458/magit-todos-pkg.el create mode 100644 elpa/magit-todos-20181220.458/magit-todos.el create mode 100644 elpa/magit-todos-readme.txt diff --git a/bba.org b/bba.org index f2c48566..8d72cb45 100644 --- a/bba.org +++ b/bba.org @@ -299,6 +299,13 @@ For annotated tags prepare message with commit messages since last tag. #+END_SRC +Display open TODO items in magit-status. + +#+BEGIN_SRC emacs-lisp :tangle yes + (require 'magit-todos) + (magit-todos-mode) +#+END_SRC + * [[https://github.com/larstvei/Focus][focus]] focus on the important stuff. diff --git a/elpa/magit-todos-20181220.458/magit-todos-autoloads.el b/elpa/magit-todos-20181220.458/magit-todos-autoloads.el new file mode 100644 index 00000000..ac45b3e8 --- /dev/null +++ b/elpa/magit-todos-20181220.458/magit-todos-autoloads.el @@ -0,0 +1,48 @@ +;;; magit-todos-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "magit-todos" "magit-todos.el" (0 0 0 0)) +;;; Generated autoloads from magit-todos.el + +(defvar magit-todos-mode nil "\ +Non-nil if Magit-Todos mode is enabled. +See the `magit-todos-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `magit-todos-mode'.") + +(custom-autoload 'magit-todos-mode "magit-todos" nil) + +(autoload 'magit-todos-mode "magit-todos" "\ +Show list of to-do items in Magit status buffer for tracked files in repo. + +\(fn &optional ARG)" t nil) + +(autoload 'magit-todos-list "magit-todos" "\ +Show to-do list of the current Git repository in a buffer. +With prefix, prompt for repository. + +\(fn &optional DIRECTORY)" t nil) + +(autoload 'magit-todos-list-internal "magit-todos" "\ +Open buffer showing to-do list of repository at DIRECTORY. + +\(fn DIRECTORY)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "magit-todos" '("magit-todos-"))) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; magit-todos-autoloads.el ends here diff --git a/elpa/magit-todos-20181220.458/magit-todos-pkg.el b/elpa/magit-todos-20181220.458/magit-todos-pkg.el new file mode 100644 index 00000000..d405b5da --- /dev/null +++ b/elpa/magit-todos-20181220.458/magit-todos-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "magit-todos" "20181220.458" "Show source file TODOs in Magit" '((emacs "25.2") (async "1.9.2") (dash "2.13.0") (f "0.17.2") (hl-todo "1.9.0") (magit "2.13.0") (pcre2el "1.8") (s "1.12.0")) :commit "4383f95ea434b41131313eadffe77c2fe8369c5d" :keywords '("magit" "vc") :authors '(("Adam Porter" . "adam@alphapapa.net")) :maintainer '("Adam Porter" . "adam@alphapapa.net") :url "http://github.com/alphapapa/magit-todos") diff --git a/elpa/magit-todos-20181220.458/magit-todos.el b/elpa/magit-todos-20181220.458/magit-todos.el new file mode 100644 index 00000000..ede0f768 --- /dev/null +++ b/elpa/magit-todos-20181220.458/magit-todos.el @@ -0,0 +1,1147 @@ +;;; magit-todos.el --- Show source file TODOs in Magit -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Adam Porter + +;; Author: Adam Porter +;; URL: http://github.com/alphapapa/magit-todos +;; Package-Version: 20181220.458 +;; Version: 1.2-pre +;; Package-Requires: ((emacs "25.2") (async "1.9.2") (dash "2.13.0") (f "0.17.2") (hl-todo "1.9.0") (magit "2.13.0") (pcre2el "1.8") (s "1.12.0")) +;; Keywords: magit, vc + +;;; Commentary: + +;; This package displays keyword entries from source code comments and Org files +;; in the Magit status buffer. Activating an item jumps to it in its file. By +;; default, it uses keywords from `hl-todo', minus a few (like "NOTE"). + +;;;; Usage: + +;; Run `magit-todos-mode', then open a Magit status buffer. + +;;;; Tips: + +;; + You can customize settings in the `magit-todos' group. + +;;; Installation: + +;;;; MELPA + +;; If you installed from MELPA, you're done. + +;;;; Manual + +;; Install these required packages: + +;; async +;; dash +;; f +;; hl-todo +;; magit +;; pcre2el +;; s + +;; Then put this file in your load-path, and put this in your init file: + +;; (require 'magit-todos) + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +;;;; Requirements + +(require 'cl-lib) +(require 'org) +(require 'grep) +(require 'seq) + +(require 'async) +(require 'dash) +(require 'f) +(require 'hl-todo) +(require 'magit) +(require 'pcre2el) +(require 's) + +;;;; Structs + +(cl-defstruct magit-todos-item + filename org-level line column position keyword suffix description) + +;;;; Variables + +(defvar magit-todos-keywords-list nil + "List of to-do keywords. +Set automatically by `magit-todos-keywords' customization.") + +(defvar magit-todos-grep-result-regexp nil + "Regular expression for grep results. +This should be set automatically by customizing +`magit-todos-keywords'.") + +(defvar magit-todos-ag-result-regexp nil + "Regular expression for ag results. +This should be set automatically by customizing +`magit-todos-keywords'.") + +(defvar magit-todos-rg-result-regexp nil + "Regular expression for rg results. +This should be set automatically by customizing +`magit-todos-keywords'.") + +(defvar magit-todos-git-grep-result-regexp nil + "Regular expression for git-grep results. +This should be set automatically by customizing +`magit-todos-keywords'.") + +(defvar magit-todos-search-regexp nil + "Regular expression to match keyword items with rg, ag, and git-grep. +This should be set automatically by customizing +`magit-todos-keywords'.") + +(defvar-local magit-todos-active-scan nil + "The current scan's process. +Used to avoid running multiple simultaneous scans for a +magit-status buffer.") + +(defvar magit-todos-section-map + (let ((map (make-sparse-keymap))) + (define-key map "jT" #'magit-todos-jump-to-todos) + (define-key map "jl" #'magit-todos-list) + (define-key map (kbd "RET") #'magit-todos-list) + map) + "Keymap for `magit-todos' top-level section.") + +(defvar magit-todos-item-section-map + (let ((map (make-sparse-keymap))) + (define-key map [remap magit-visit-thing] #'magit-todos-jump-to-item) + (define-key map [remap magit-diff-show-or-scroll-up] #'magit-todos-peek-at-item) + map) + "Keymap for `magit-todos' individual to-do item sections. +See https://magit.vc/manual/magit/Creating-Sections.html for more +details about how section maps work.") + +(defvar-local magit-todos-show-filenames nil + "Whether to show filenames next to to-do items. +Set automatically depending on grouping.") + +(defvar-local magit-todos-updating nil + "Whether items are being updated now.") + +(defvar-local magit-todos-last-update-time nil + "When the items were last updated. +A time value as returned by `current-time'.") + +(defvar-local magit-todos-item-cache nil + "Items found by most recent scan.") + +(defvar magit-todos-scanners nil + "Scanners defined by `magit-todos-defscanner'.") + +;;;; Customization + +(defgroup magit-todos nil + "Show TODO items in source code comments in repos' files." + :group 'magit) + +(defcustom magit-todos-scanner nil + "File scanning method. +\"Automatic\" will attempt to use rg, ag, git-grep, and +find-grep, in that order. " + :type '(choice (const :tag "Automatic" nil) + (function :tag "Custom function")) + :set (lambda (option value) + (when magit-todos-scanners + ;; Only try to set when scanners are defined. + (unless value + ;; Choosing automatically + (setq value (or (magit-todos--choose-scanner) + (progn + (display-warning 'magit-todos + "`magit-todos' was unable to find a suitable scanner. Please install \"rg\", or a PCRE-compatible version of \"git\" or \"grep\". Disabling `magit-todos-mode'." + :error) + (magit-todos-mode -1) + nil)))) + (set-default option value)))) + +(defcustom magit-todos-nice t + "Run scanner with \"nice\"." + :type 'boolean) + +(defcustom magit-todos-ignore-case nil + "Upcase keywords found in files. +If nil, a keyword like \"Todo:\" will not be shown. `upcase' can +be a relatively expensive function, so this can be disabled if +necessary." + :type 'boolean) + +(defcustom magit-todos-update t + "When or how often to scan for to-dos. +When set to manual updates, the list can be updated with the +command `magit-todos-update'. When caching is enabled, scan for +items whenever the Magit status buffer is refreshed and at least +N seconds have passed since the last scan; otherwise, use cached +items." + :type '(choice (const :tag "Automatically, when the Magit status buffer is refreshed" t) + (integer :tag "Automatically, but cache items for N seconds") + (const :tag "Manually" nil))) + +(defcustom magit-todos-fontify-keyword-headers t + "Apply keyword faces to group keyword headers." + :type 'boolean) + +(defcustom magit-todos-keyword-suffix (rx (optional "(" (1+ (not (any ")"))) ")") ":") + "Regular expression matching suffixes after keywords. +e.g. to match a keyword like \"TODO(user):\", use \"([^)]+):\". + +If the suffix should be optional, the entire regexp should be +made explicitly optional. However, it is not necessary to +account for optional whitespace after the suffix, as this is done +automatically. + +Note: the suffix applies only to non-Org files." + :type `(choice (const :tag "Optional username in parens, then required colon (matching e.g. \"TODO:\" or \"TODO(user):\")" + ,(rx (optional "(" (1+ (not (any ")"))) ")") ":")) + (const :tag "Required colon (matching e.g. \"TODO:\"" ":") + (string :tag "Custom regexp")) + :package-version '(magit-todos . "1.2")) + +(defcustom magit-todos-ignored-keywords '("NOTE" "DONE") + "Ignored keywords. Automatically removed from `magit-todos-keywords'." + :type '(repeat string) + :set (lambda (option value) + (set-default option value) + (when (boundp 'magit-todos-keywords) + ;; Avoid setting `magit-todos-keywords' before it's defined. + + ;; HACK: Testing with `fboundp' is the only way I have been able to find that fixes this + ;; problem. I tried using ":set-after '(magit-todos-ignored-keywords)" on + ;; `magit-todos-keywords', but it had no effect. I looked in the manual, which seems to + ;; suggest that using ":initialize 'custom-initialize-safe-set" might fix it--but that + ;; function is no longer to be found in the Emacs source tree. It was committed in 2005, + ;; and now it's gone, but the manual still mentions it. ??? + (custom-reevaluate-setting 'magit-todos-keywords)))) + +(defcustom magit-todos-keywords 'hl-todo-keyword-faces + "To-do keywords to display in Magit status buffer. +If set to a list variable, may be a plain list or an alist in +which the keys are the keywords. + +When set, sets `magit-todos-search-regexp' to the appropriate +regular expression." + :type '(choice (repeat :tag "Custom list" string) + (const :tag "Keywords from `hl-todo'" hl-todo-keyword-faces) + (variable :tag "List variable")) + :set (lambda (option value) + (set-default option value) + (let ((keywords (cl-typecase value + (null (user-error "Please add some keywords")) + (symbol (if (and (consp (symbol-value value)) + (consp (car (symbol-value value)))) + (mapcar #'car (symbol-value value)) + (symbol-value value))) + (list value)))) + (setq magit-todos-keywords-list (seq-difference keywords magit-todos-ignored-keywords))))) + +(defcustom magit-todos-max-items 10 + "Automatically collapse the section if there are more than this many items." + :type 'integer) + +(defcustom magit-todos-auto-group-items 20 + "Whether or when to automatically group items." + :type '(choice (integer :tag "When there are more than this many items") + (const :tag "Always" always) + (const :tag "Never" never))) + +(defcustom magit-todos-buffer-item-factor 10 + "Multiply `magit-todos-auto-group-items' and `magit-todos-max-items' by this factor in dedicated `magit-todos' buffers." + :type 'integer) + +(defcustom magit-todos-group-by '(magit-todos-item-keyword magit-todos-item-filename) + "How to group items. +One or more attributes may be chosen, and they will be grouped in +order." + :type '(repeat (choice (const :tag "By filename" magit-todos-item-filename) + (const :tag "By keyword" magit-todos-item-keyword) + (const :tag "By suffix" magit-todos-item-suffix) + (const :tag "By first path component" magit-todos-item-first-path-component)))) + +(defcustom magit-todos-fontify-org t + "Fontify items from Org files as Org headings." + :type 'boolean) + +(defcustom magit-todos-sort-order '(magit-todos--sort-by-keyword + magit-todos--sort-by-filename + magit-todos--sort-by-position) + "Order in which to sort items." + :type '(repeat (choice (const :tag "Keyword" magit-todos--sort-by-keyword) + (const :tag "Suffix" magit-todos--sort-by-suffix) + (const :tag "Filename" magit-todos--sort-by-filename) + (const :tag "Buffer position" magit-todos--sort-by-position) + (function :tag "Custom function")))) + +(defcustom magit-todos-depth nil + "Maximum depth of files in repo working tree to scan for to-dos. +A value of 0 means to search only the current directory, while a +value of 1 means to search directories one level deeper, etc. +Deeper scans can be slow in large projects. You may wish to set +this in a directory-local variable for certain projects." + :type '(choice (const :tag "Unlimited" nil) + (const :tag "Repo root directory only" 0) + (integer :tag "N levels below the repo root"))) + +(defcustom magit-todos-insert-at 'bottom + "Insert the to-dos section after this section in the Magit status buffer. +Specific sections may be chosen, using the first symbol returned +by evaluating \"(magit-section-ident (magit-current-section))\" +in the status buffer with point on the desired section, +e.g. `recent' for the \"Recent commits\" section. Note that this +may not work exactly as desired when the built-in scanner is +used." + :type '(choice (const :tag "Top" top) + (const :tag "Bottom" bottom) + (const :tag "After untracked files" untracked) + (const :tag "After unstaged files" unstaged) + (symbol :tag "After selected section"))) + +(defcustom magit-todos-exclude-globs nil + "Glob patterns to exclude from searches." + :type '(repeat string)) + +;;;; Commands + +;;;###autoload +(define-minor-mode magit-todos-mode + "Show list of to-do items in Magit status buffer for tracked files in repo." + :require 'magit-todos + :group 'magit-todos + :global t + (if magit-todos-mode + (progn + (if (lookup-key magit-status-mode-map "jT") + (message "magit-todos: Not overriding bind of \"jT\" in `magit-status-mode-map'.") + (define-key magit-status-mode-map "jT" #'magit-todos-jump-to-todos)) + (magit-add-section-hook 'magit-status-sections-hook + #'magit-todos--insert-todos + 'magit-insert-staged-changes + 'append) + (add-hook 'magit-status-mode-hook #'magit-todos--add-to-status-buffer-kill-hook 'append)) + ;; Disable mode + (when (equal (lookup-key magit-status-mode-map "jT") #'magit-jump-to-todos) + (define-key magit-status-mode-map "jT" nil)) + (remove-hook 'magit-status-sections-hook #'magit-todos--insert-todos) + (remove-hook 'magit-status-mode-hook #'magit-todos--add-to-status-buffer-kill-hook))) + +(defun magit-todos-update () + "Update the to-do list manually. +Only necessary when option `magit-todos-update' is nil." + (interactive) + (unless magit-todos-mode + (user-error "Please activate `magit-todos-mode'")) + (let ((inhibit-read-only t)) + (magit-todos--delete-section [* todos]) + ;; HACK: See other note on `magit-todos-updating'. + (setq magit-todos-updating t) + (magit-todos--insert-todos))) + +(defun magit-todos-jump-to-item (&optional peek) + "Show current item. +If PEEK is non-nil, keep focus in status buffer window." + (interactive) + (let* ((status-window (selected-window)) + (item (oref (magit-current-section) value)) + (buffer (magit-todos--item-buffer item))) + (pop-to-buffer buffer) + (magit-todos--goto-item item) + (when (derived-mode-p 'org-mode) + (org-show-entry)) + (when peek + (select-window status-window)))) + +(defun magit-todos-peek-at-item () + "Peek at current item." + (interactive) + (magit-todos-jump-to-item 'peek)) + +;;;;; Jump to section + +(magit-define-section-jumper magit-jump-to-todos "TODOs" todos) + +(defun magit-todos-jump-to-todos () + "Jump to TODOs section, and update it if empty." + (interactive) + (let ((already-in-section-p (magit-section-match [* todos]))) + (magit-jump-to-todos) + (when (and (or (integerp magit-todos-update) + (not magit-todos-update)) + (or already-in-section-p + (= 0 (length (oref (magit-current-section) children))))) + (magit-todos-update)))) + +;;;; Dedicated buffer + +;;;###autoload +(defun magit-todos-list (&optional directory) + "Show to-do list of the current Git repository in a buffer. +With prefix, prompt for repository." + ;; Mostly copied from `magit-status' + (interactive + (let ((magit--refresh-cache (list (cons 0 0)))) + (list (and (or current-prefix-arg (not (magit-toplevel))) + (magit-read-repository))))) + (condition-case nil + (let ((magit--refresh-cache (list (cons 0 0)))) + (setq directory (if directory + (file-name-as-directory (expand-file-name directory)) + default-directory)) + (magit-todos-list-internal directory)) + ('magit-outside-git-repo (cl-letf (((symbol-function 'magit-toplevel) (lambda (&rest _) default-directory))) + (call-interactively #'magit-todos-list))))) + +(put 'magit-todos-list 'interactive-only 'magit-todos-list-internal) + +;;;###autoload +(defun magit-todos-list-internal (directory) + "Open buffer showing to-do list of repository at DIRECTORY." + (magit--tramp-asserts directory) + (let ((default-directory directory)) + (magit-mode-setup #'magit-todos-list-mode))) + +(define-derived-mode magit-todos-list-mode magit-status-mode "Magit" + "Mode for looking at repository to-do list. + +\\\ +Type \\[magit-refresh] to refresh the list. +Type \\[magit-section-toggle] to expand or hide the section at point. +Type \\[magit-visit-thing] to visit the item at point. +Type \\[magit-diff-show-or-scroll-up] to peek at the item at point." + :group 'magit-todos) + +(defun magit-todos-list-refresh-buffer () + "Refresh the current `magit-todos-list-mode' buffer." + (setq-local magit-todos-max-items (* magit-todos-max-items magit-todos-buffer-item-factor)) + (setq-local magit-todos-auto-group-items (* magit-todos-auto-group-items magit-todos-buffer-item-factor)) + (magit-section-show (magit-insert-section (type magit-root-section) + (magit-insert-status-headers) + (magit-todos--insert-todos)))) + +;;;; Functions + +(defun magit-todos--coalesce-groups (groups) + "Return GROUPS, coalescing any groups with `equal' keys. +GROUPS should be an alist. Assumes that each group contains +unique items. Intended for post-processing the result of +`-group-by'." + (cl-loop with keys = (-uniq (-map #'car groups)) + for key in keys + for matching-groups = (--select (equal key (car it)) groups) + collect (cons key (apply #'append (-map #'cdr matching-groups))))) + +(defun magit-todos--add-to-status-buffer-kill-hook () + "Add `magit-todos--kill-active-scan' to `kill-buffer-hook' locally." + (add-hook 'kill-buffer-hook #'magit-todos--kill-active-scan 'append 'local)) + +(defun magit-todos--kill-active-scan () + "Kill `magit-todos-active-scan'. +To be called in status buffers' `kill-buffer-hook'." + (when (and magit-todos-active-scan + (process-live-p magit-todos-active-scan)) + (kill-process magit-todos-active-scan) + (when-let* ((buffer (process-buffer magit-todos-active-scan)) + (alive (buffer-live-p buffer))) + (kill-buffer buffer)))) + +(defun magit-todos--add-to-custom-type (symbol value) + "Add VALUE to the end of SYMBOL's `custom-type' property." + (declare (indent defun)) + (pcase-let* ((`(,type . ,choices) (get symbol 'custom-type)) + (choices (append (list value) choices))) + (put symbol 'custom-type + (append (list type) choices)))) + +(defun magit-todos--choose-scanner () + "Return function to call to scan for items with. +Chooses automatically in order defined in `magit-todos-scanners'." + (cl-loop for scanner in magit-todos-scanners + ;; I guess it would be better to avoid `eval', but it seems like the natural + ;; way to do this. + when (eval (alist-get 'test scanner)) + return (alist-get 'function scanner))) + +(defun magit-todos--scan-callback (magit-status-buffer results-regexp process) + "Callback for `magit-todos--git-grep-scan-async'." + ;; SOMEDAY: Perhaps move process buffer parsing into separate function. + (with-current-buffer (process-buffer process) + (goto-char (point-min)) + (magit-todos--insert-items magit-status-buffer + (cl-loop for item = (magit-todos--line-item results-regexp) + while item + collect item + do (forward-line 1))))) + +(defun magit-todos--delete-section (condition) + "Delete the section specified by CONDITION from the Magit status buffer. +See `magit-section-match'. Also delete it from root section's children." + (save-excursion + (goto-char (point-min)) + (when-let ((section (cl-loop until (magit-section-match condition) + ;; Use `forward-line' instead of `magit-section-forward' because + ;; sometimes it skips our section. + do (forward-line 1) + when (eobp) + return nil + finally return (magit-current-section)))) + ;; Delete the section from root section's children. This makes the section-jumper command + ;; work when a replacement section is inserted after deleting this section. + (object-remove-from-list magit-root-section 'children section) + (with-slots (start end) section + ;; NOTE: We delete 1 past the end because we insert a newline after the section. I'm not + ;; sure if this would generalize to all Magit sections. + (delete-region start (1+ end)))))) + +(defun magit-todos--item-buffer (item) + "Return buffer visiting ITEM." + (or (find-buffer-visiting (magit-todos-item-filename item)) + (find-file-noselect (magit-todos-item-filename item)))) + +(defun magit-todos--goto-item (item) + "Move point to ITEM. +Assumes current buffer is ITEM's buffer." + (pcase-let* (((cl-struct magit-todos-item position line column keyword) item)) + (if position + (goto-char position) + (goto-char (point-min)) + (forward-line (1- line)) + (if column + (forward-char column) + (when (re-search-forward (regexp-quote keyword) (line-end-position) t) + (goto-char (match-beginning 0))))))) + +(defun magit-todos--insert-todos () + "Insert to-do items into current buffer. +This function should be called from inside a ‘magit-status’ buffer." + (declare (indent defun)) + (when magit-todos-active-scan + ;; Avoid running multiple scans for a single magit-status buffer. + (let ((buffer (process-buffer magit-todos-active-scan))) + (when (process-live-p magit-todos-active-scan) + (delete-process magit-todos-active-scan)) + (when (buffer-live-p buffer) + (kill-buffer buffer))) + (setq magit-todos-active-scan nil)) + (pcase magit-todos-update + ((or 't ; Automatic + ;; Manual and updating now + (and 'nil (guard magit-todos-updating)) + ;; Caching and cache expired + (and (pred integerp) (guard (or magit-todos-updating ; Forced update + (>= (float-time + (time-subtract (current-time) + magit-todos-last-update-time)) + magit-todos-update) + (null magit-todos-last-update-time))))) + ;; Scan and insert. + ;; HACK: I don't like setting a special var here, because it seems like lexically binding a + ;; special var should follow down the chain, but it isn't working, so we'll do this. + (setq magit-todos-updating t) + (setq magit-todos-active-scan (funcall magit-todos-scanner + :magit-status-buffer (current-buffer) + :directory default-directory + :depth magit-todos-depth))) + (_ ; Caching and cache not expired, or not automatic and not manually updating now + (magit-todos--insert-items (current-buffer) magit-todos-item-cache)))) + +(defun magit-todos--insert-items (magit-status-buffer items) + "Insert to-do ITEMS into MAGIT-STATUS-BUFFER." + (declare (indent defun)) + ;; NOTE: This could be factored out into some kind of `magit-insert-section-async' macro if necessary. + (when (not (buffer-live-p magit-status-buffer)) + (message "`magit-todos--insert-items-callback': Callback called for deleted buffer")) + (let* ((items (magit-todos--sort items)) + (num-items (length items)) + (group-fns (pcase magit-todos-auto-group-items + ('never nil) + ('always magit-todos-group-by) + ((pred integerp) (when (> num-items magit-todos-auto-group-items) + magit-todos-group-by)) + (_ (error "Invalid value for magit-todos-auto-group-items")))) + (magit-todos-show-filenames (not (member 'magit-todos-item-filename group-fns))) + (magit-section-show-child-count t) + ;; HACK: "For internal use only." But this makes collapsing the new section work! + (magit-insert-section--parent magit-root-section) + (inhibit-read-only t)) + (when (buffer-live-p magit-status-buffer) + ;; Don't try to select a killed status buffer + (with-current-buffer magit-status-buffer + (when magit-todos-updating + (when (or (null magit-todos-update) ; Manual updates + (integerp magit-todos-update)) ; Caching + (setq magit-todos-item-cache items) + (setq magit-todos-last-update-time (current-time))) + ;; HACK: I don't like setting this special var, but it works. See other comment where + ;; it's set t. + (setq magit-todos-updating nil)) + (save-excursion + ;; Insert items + (goto-char (point-min)) + ;; Go to insertion position + (pcase magit-todos-insert-at + ('top (cl-loop for ((this-section . _) . _) = (magit-section-ident (magit-current-section)) + until (not (member this-section '(branch tags))) + do (magit-section-forward))) + ('bottom (goto-char (point-max))) + (_ (magit-todos--skip-section (vector '* magit-todos-insert-at)))) + ;; Insert section + (let ((reminder (if magit-todos-update + "" ; Automatic updates: no reminder + ;; Manual updates: remind user + " (update manually)"))) + (if (not items) + (unless magit-todos-update + ;; Manual updates: Insert section to remind user + (let ((magit-insert-section--parent magit-root-section)) + (magit-insert-section (todos) + (magit-insert-heading (concat "TODOs (0)" reminder))) + (insert "\n"))) + (let ((section (magit-todos--insert-groups :type 'todos + :heading (format "TODOs (%s)%s" num-items reminder) + :group-fns group-fns + :items items + :depth 0))) + (insert "\n") + (magit-todos--set-visibility :section section :num-items num-items))))))))) + +(cl-defun magit-todos--insert-groups (&key depth group-fns heading type items) + "Insert ITEMS into grouped Magit section and return the section. + +DEPTH sets indentation and should be 0 for a top-level group. It +is automatically incremented when this function calls itself. + +GROUP-FNS may be a list of functions to which ITEMS are applied +with `-group-by' to group them. Items are grouped +hierarchically, i.e. when GROUP-FNS has more than one function, +items are first grouped by the first function, then subgroups are +created which group items by subsequent functions. + +HEADING is a string which is the group's heading. The count of +items in each group is automatically appended. + +TYPE is a symbol which is used by Magit internally to identify +sections." + ;; NOTE: `magit-insert-section' seems to bind `magit-section-visibility-cache' to nil, so setting + ;; visibility within calls to it probably won't work as intended. + (declare (indent defun)) + (let* ((indent (s-repeat (* 2 depth) " ")) + (heading (concat indent heading)) + (magit-insert-section--parent (if (= 0 depth) + magit-root-section + magit-insert-section--parent))) + (if (and (consp group-fns) + (> (length group-fns) 0)) + ;; Insert more groups + (let* ((groups (--> (-group-by (car group-fns) items) + (cl-loop for group in-ref it + ;; HACK: Set ":" keys to nil so they'll be grouped together. + do (pcase (car group) + (":" (setf (car group) nil))) + finally return it) + (magit-todos--coalesce-groups it))) + (section (magit-insert-section ((eval type)) + (magit-insert-heading heading) + (cl-loop for (group-type . items) in groups + for group-name = (pcase group-type + ;; Use "[Other]" instead of empty group name. + ;; HACK: ":" is hard-coded, even though the + ;; suffix regexp could differ. If users change + ;; the suffix so this doesn't apply, it + ;; shouldn't cause any problems, it just won't + ;; look as pretty. + ((or "" ":" 'nil) "[Other]") + (_ (s-chop-suffix ":" group-type))) + do (magit-todos--insert-groups + :depth (1+ depth) :group-fns (cdr group-fns) + :type (intern group-name) :items items + :heading (concat + (if (and magit-todos-fontify-keyword-headers + (member group-name magit-todos-keywords-list)) + (propertize group-name 'face (magit-todos--keyword-face group-name)) + group-name) + ;; Item count + (if (= 1 (length group-fns)) + ":" ; Let Magit add the count. + ;; Add count ourselves. + (concat " " (format "(%s)" (length items)))))))))) + (magit-todos--set-visibility :depth depth :num-items (length items) :section section) + ;; Add top-level section to root section's children + (when (= 0 depth) + (push section (oref magit-root-section children))) + ;; Don't forget to return the section! + section) + ;; Insert individual to-do items + (magit-todos--insert-group :depth (1+ depth) :type type :items items :heading heading)))) + +(cl-defun magit-todos--insert-group (&key depth heading type items) + "Insert ITEMS into Magit section and return the section. + +DEPTH sets indentation and should be 0 for a top-level group. + +HEADING is a string which is the group's heading. The count of +items in each group is automatically appended. + +TYPE is a symbol which is used by Magit internally to identify +sections." + ;; NOTE: `magit-insert-section' seems to bind `magit-section-visibility-cache' to nil, so setting + ;; visibility within calls to it probably won't work as intended. + (declare (indent defun)) + (let* ((indent (s-repeat (* 2 depth) " ")) + (magit-insert-section--parent (if (= 0 depth) + magit-root-section + magit-insert-section--parent)) + (width (- (window-text-width) depth)) + (section (magit-insert-section ((eval type)) + (magit-insert-heading heading) + (dolist (item items) + (let* ((filename (propertize (magit-todos-item-filename item) 'face 'magit-filename)) + (string (--> (concat indent + (when magit-todos-show-filenames + (concat filename " ")) + (funcall (if (s-suffix? ".org" filename) + #'magit-todos--format-org + #'magit-todos--format-plain) + item)) + (truncate-string-to-width it width)))) + (magit-insert-section (todos-item item) + (insert string)) + (insert "\n")))))) + (magit-todos--set-visibility :depth depth :num-items (length items) :section section) + ;; Don't forget to return the section! + section)) + +(cl-defun magit-todos--set-visibility (&key section num-items depth) + "Set the visibility of SECTION. + +If the section's visibility is cached by Magit, the cached +setting is applied. Otherwise, visibility is set according to +whether NUM-ITEMS is greater than `magit-todos-max-items'. + +When DEPTH is greater than 0, NUM-ITEMS is compared to +`magit-todos-max-items' divided by DEPTH multiplied by 2, +i.e. the max number of items which cause sections to be +automatically hidden halves at each deeper level." + (declare (indent defun)) + (pcase (magit-section-cached-visibility section) + ('hide (magit-section-hide section)) + ('show (magit-section-show section)) + (_ (if (> num-items (pcase depth + (0 magit-todos-max-items) + (_ (/ magit-todos-max-items (* depth 2))))) + ;; HACK: We have to do this manually because the set-visibility-hook doesn't work. + (magit-section-hide section) + ;; Not hidden: show section manually (necessary for some reason) + (magit-section-show section))))) + +(defun magit-todos--skip-section (condition) + "Move past the section matching CONDITION. +See `magit-section-match'." + (goto-char (point-min)) + (cl-loop until (magit-section-match condition) + do (magit-section-forward)) + (cl-loop until (not (magit-section-match condition)) + do (condition-case nil + ;; `magit-section-forward' raises an error when there are no more sections. + (magit-section-forward) + (error (progn + (goto-char (1- (point-max))) + (cl-return)))))) + +(cl-defun magit-todos--line-item (regexp &optional filename) + "Return item on current line, parsing current buffer with REGEXP. +FILENAME is added to the item as its filename. Sets match data. +This should be called in a process's output buffer from one of +the async callback functions. The calling function should +advance to the next line." + (let ((case-fold-search magit-todos-ignore-case)) + (when (re-search-forward regexp (line-end-position) t) + (make-magit-todos-item :filename (or filename + (match-string 8)) + :line (--when-let (match-string 2) + (string-to-number it)) + :column (--when-let (match-string 3) + (string-to-number it)) + :position (--when-let (match-string 9) + (string-to-number it)) + :org-level (match-string 1) + :keyword (match-string 4) + :suffix (match-string 6) + :description (match-string 5))))) + +(defun magit-todos--keyword-face (keyword) + "Return face for KEYWORD." + ;; TODO(alphapapa): Instead of upcasing here, upcase in the lookup, so it can still be displayed + ;; non-uppercase. Preserving the distinction might be useful. + (when magit-todos-ignore-case + (setq keyword (upcase keyword))) + (let ((face (assoc-default keyword hl-todo-keyword-faces #'string=))) + (cl-typecase face + (string (list :inherit 'hl-todo :foreground face)) + (t face)))) + +(defun magit-todos--fontify-like-in-org-mode (s &optional odd-levels) + "Fontify string S like in Org-mode. + +`org-fontify-like-in-org-mode' is a very, very slow function +because it creates a new temporary buffer and runs `org-mode' for +every string it fontifies. This function reuses a single +invisible buffer and only runs `org-mode' when the buffer is +created." + (let ((buffer (get-buffer " *magit-todos--fontify-like-in-org-mode*"))) + (unless buffer + (setq buffer (get-buffer-create " *magit-todos--fontify-like-in-org-mode*")) + (with-current-buffer buffer + (buffer-disable-undo) + (org-mode))) + (with-current-buffer buffer + (erase-buffer) + (insert s) + (let ((org-odd-levels-only odd-levels)) + (font-lock-ensure) + (buffer-string))))) + +(defun magit-todos-item-first-path-component (item) + "Return ITEM's first directory. +This assumes that ITEM's filename is already set to a path +relative to the repo's directory (i.e. this would not be very +useful with absolute paths)." + (car (f-split (magit-todos-item-filename item)))) + +(cl-defun magit-todos--async-start-process (name &key command finish-func) + "Start the executable PROGRAM asynchronously. See `async-start'. +PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the +process object when done. If FINISH-FUNC is nil, the future +object will return the process object when the program is +finished. Set DEFAULT-DIRECTORY to change PROGRAM's current +working directory. + +This is a copy of `async-start-process' that does not override +`process-connection-type'. It also uses keyword arguments." + (declare (indent defun)) + ;; TODO: Drop this function when possible. See + ;; . + (let* ((args (cdr command)) + (command (car command)) + (buf (generate-new-buffer (concat " *" name "*"))) + (proc (apply #'start-process name buf command args))) + (with-current-buffer buf + (set-process-query-on-exit-flag proc nil) + (set (make-local-variable 'async-callback) finish-func) + (set-process-sentinel proc #'async-when-done) + (unless (string= name "emacs") + (set (make-local-variable 'async-callback-for-process) t)) + proc))) + +;;;;; Formatters + +(defun magit-todos--format-plain (item) + "Return ITEM formatted as from a non-Org file." + (format "%s%s %s" + (propertize (magit-todos-item-keyword item) + 'face (magit-todos--keyword-face (magit-todos-item-keyword item))) + (or (magit-todos-item-suffix item) "") + (or (magit-todos-item-description item) ""))) + +(defun magit-todos--format-org (item) + "Return ITEM formatted as from an Org file." + (magit-todos--fontify-like-in-org-mode + (concat (magit-todos-item-org-level item) " " + (magit-todos-item-keyword item) " " + (magit-todos-item-description item)))) + +;;;;; Sorting + +(defun magit-todos--sort (items) + "Return ITEMS sorted according to `magit-todos-sort-order'." + (dolist (fn (reverse magit-todos-sort-order) items) + (setq items (sort items fn)))) + +(defun magit-todos--sort-by-keyword (a b) + "Return non-nil if A's keyword is before B's in `magit-todos-keywords-list'." + (cl-flet ((keyword-index (keyword) + (or (-elem-index keyword magit-todos-keywords-list) 0))) + (< (keyword-index (magit-todos-item-keyword a)) + (keyword-index (magit-todos-item-keyword b))))) + +(defun magit-todos--sort-by-position (a b) + "Return non-nil if A's position in its file is before B's." + (let ((a-position (or (magit-todos-item-position a) + (magit-todos-item-line a))) + (b-position (or (magit-todos-item-position b) + (magit-todos-item-line b)))) + (< a-position b-position))) + +(defun magit-todos--sort-by-filename (a b) + "Return non-nil if A's filename is `string<' B's." + (string< (magit-todos-item-filename a) + (magit-todos-item-filename b))) + +(defun magit-todos--sort-by-suffix (a b) + "Return non-nil if A's suffix is `string<' B's." + (string< (magit-todos-item-suffix a) + (magit-todos-item-suffix b))) + +;;;; Scanners + +(cl-defmacro magit-todos-defscanner (name &key test command results-regexp) + "Define a `magit-todos' scanner named NAME. + +NAME is a string, which may contain spaces. It is only used for +descriptive purposes. + +TEST is an unquoted sexp which is used to determine whether the +scanner is usable. In most cases, it should use +`executable-find' to look for the scanner command. + +COMMAND is a sexp which should evaluate to the scanner command, +i.e. a list of strings to be eventually passed to +`start-process'. Nil elements are removed, numbers are converted +to strings, and nested lists are flattened into a single list. +It is evaluated each time the scanner is run. + +Within the COMMAND list these variables are available: + +`depth': When non-nil, an integer, which is the depth that should +be passed to the scanner's max-depth option (i.e. `magit-todos-depth'). + +`directory': The directory in which the scan should be run. + +`extra-args': The value of the customization variable +\"magit-todos-NAME-extra-args\" (see below). + +`keywords': List of item keywords defined in +`magit-todos-keywords-list'. + +`search-regexp': The regular expression to be passed to the +scanner. + +RESULTS-REGEXP is an optional string or unquoted sexp which is +used to match results in the scanner process's output buffer. +Typically this will be a sexp which calls `rx-to-string'. It is +evaluated each time the scanner is run. If nil, the appropriate +default is used which matches results in the form: + + FILENAME:LINE:MATCH + +Where MATCH may also match Org outline heading stars when +appropriate. Custom regexps may also match column numbers or +byte offsets in the appropriate numbered groups; see +`make-magit-todos-item'. + +The macro defines the following: + +\"magit-todos-NAME-extra-args\": A customization setting, a list +of strings to be passed to the scanner as extra arguments. + +\"magit-todos--scan-with-NAME\": The function which runs the +scanner command. + +It also adds the scanner to the customization variable +`magit-todos-scanner', and to the variable +`magit-todos-scanners' (which is used to set +`magit-todos-scanner' by calling `magit-todos--choose-scanner')." + ;; TODO: Try to obviate the -scanners variable, let --choose-scanner use the + ;; custom-type of -scanner directly. Maybe, anyway--I don't want to ugly up the UI + ;; for users. + (declare (indent defun) (debug (stringp [&rest &or [":test" def-form] + [":command" def-form] + [":results-regexp" [&or stringp def-form]]]))) + (let* ((name-without-spaces (s-replace " " "-" name)) + (scan-fn-name (concat "magit-todos--scan-with-" name-without-spaces)) + (scan-fn-symbol (intern scan-fn-name)) + (extra-args-var (intern (format "magit-todos-%s-extra-args" name-without-spaces)))) + `(progn + (defcustom ,extra-args-var nil + ,(format "Extra arguments passed to %s." name) + :type '(repeat string)) + (cl-defun ,scan-fn-symbol (&key magit-status-buffer directory depth) + ,(format "Scan for to-dos with %s, then call `magit-todos--scan-callback'. +MAGIT-STATUS-BUFFER is what it says. DIRECTORY is the directory in which to run the scan. DEPTH should be an integer, typically the value of `magit-todos-depth'." + name) + (let* ((process-connection-type 'pipe) + (directory (f-relative directory default-directory)) + (extra-args (when ,extra-args-var + (--map (s-split (rx (1+ space)) it 'omit-nulls) + ,extra-args-var))) + (keywords magit-todos-keywords-list) + (search-regexp (rxt-elisp-to-pcre + (rx-to-string + `(or + ;; Org item + (seq bol (group (1+ "*")) + (1+ blank) + (group (or ,@keywords)) + (1+ space) + (group (1+ not-newline))) + ;; Non-Org + (seq (or bol (1+ blank)) + (group (or ,@keywords)) + (regexp ,magit-todos-keyword-suffix) + (optional (1+ blank) + (group (1+ not-newline)))))))) + (results-regexp (or ,results-regexp + (rx-to-string + `(seq bol + ;; Filename + (group-n 8 (1+ (not (any ":")))) ":" + ;; Line + (group-n 2 (1+ digit)) ":" + (or + ;; Org item + (seq (group-n 1 (1+ "*")) + (1+ blank) + (group-n 4 (or ,@keywords)) + (1+ blank) + (group-n 5 (1+ not-newline))) + ;; Non-Org + (seq (optional (1+ not-newline)) + (group-n 4 (or ,@keywords)) + (optional (group-n 6 (regexp ,magit-todos-keyword-suffix))) + (optional (1+ blank)) + (optional (group-n 5 (1+ not-newline))))))))) + (command (-flatten + (-non-nil + (list (when magit-todos-nice + (list "nice" "-n5")) + ,command))))) + ;; Convert any numbers in command to strings (e.g. depth). + (cl-loop for elt in-ref command + when (numberp elt) + do (setf elt (number-to-string elt))) + (magit-todos--async-start-process ,scan-fn-name + :command command + :finish-func (apply-partially #'magit-todos--scan-callback magit-status-buffer results-regexp)))) + (magit-todos--add-to-custom-type 'magit-todos-scanner + (list 'const :tag ,name #',scan-fn-symbol)) + (add-to-list 'magit-todos-scanners + (list (cons 'name ,name) + (cons 'function #',scan-fn-symbol) + (cons 'test ',test)) + 'append)))) + +;; NOTE: These scanners handle the max-depth option differently. git-grep seems to handle it in the +;; most useful way, with a setting of 0 meaning to look no deeper than the current directory, and a +;; setting of 1 searching directories one level deeper. In comparison, rg and find effectively +;; subtract one from the value, as a setting of 0 returns no results, and a setting of 1 searches +;; only the current directory (which means that when the max-depth is set to 0, the whole command is +;; essentially a no-op, which is pointless). Since we want `magit-todos-depth' to behave +;; consistently with all scanners, we will treat it the way git-grep does, and for the other +;; scanners we'll add one to its value. + +(magit-todos-defscanner "rg" + :test (executable-find "rg") + :command (list "rg" "--no-heading" + (when depth + (list "--maxdepth" (1+ depth))) + (when magit-todos-ignore-case + "--ignore-case") + (when magit-todos-exclude-globs + (--map (list "--glob" (concat "!" it)) + magit-todos-exclude-globs)) + extra-args search-regexp directory)) + +(magit-todos-defscanner "git grep" + :test (string-match "--perl-regexp" (shell-command-to-string "git grep --help")) + :command (list "git" "--no-pager" "grep" + "--full-name" "--no-color" "-n" + (when depth + (list "--max-depth" depth)) + (when magit-todos-ignore-case + "--ignore-case") + "--perl-regexp" + "-e" search-regexp + extra-args "--" directory + (when magit-todos-exclude-globs + (--map (concat ":!" it) + magit-todos-exclude-globs)))) + +(magit-todos-defscanner "find|grep" + ;; NOTE: The filenames output by find|grep have a leading "./". I don't expect this scanner to be + ;; used much, if at all, so I'm not going to go to the trouble to fix this now. + :test (string-match "--perl-regexp" (shell-command-to-string "grep --help")) + :command (let* ((grep-find-template (progn + (unless grep-find-template + (grep-compute-defaults)) + (->> grep-find-template + (s-replace " grep " " grep -b -E ") + (s-replace " -nH " " -H ")))) + (_ (when depth + (setq grep-find-template + (s-replace " " (concat " -maxdepth " (1+ depth) " ") + grep-find-template))))) + ;; Modified from `rgrep-default-command' + (list "find" directory + (list (when grep-find-ignored-directories + (list "-type" "d" + "(" "-path" + (-interpose (list "-o" "-path") + (-non-nil (--map (cond ((stringp it) + (concat "*/" it)) + ((consp it) + (and (funcall (car it) it) + (concat "*/" (cdr it))))) + grep-find-ignored-directories))) + ")" "-prune")) + (when grep-find-ignored-files + (list "-o" "-type" "f" + "(" "-name" + (-interpose (list "-o" "-name") + (--map (cond ((stringp it) it) + ((consp it) (and (funcall (car it) it) + (cdr it)))) + grep-find-ignored-files)) + ")" "-prune")) + (when magit-todos-exclude-globs + (list "-o" "(" + (--map (list "-iname" it) + magit-todos-exclude-globs) + ")" "-prune"))) + (list "-o" "-type" "f") + ;; NOTE: This uses "grep -P", i.e. "Interpret the pattern as a + ;; Perl-compatible regular expression (PCRE). This is highly + ;; experimental and grep -P may warn of unimplemented features." But it + ;; does seem to work properly, at least on GNU grep. Using "grep -E" + ;; with this PCRE regexp doesn't work quite right, as it doesn't match + ;; all the keywords, but pcre2el doesn't convert to "extended regular + ;; expressions", so this will have to do. Maybe we should test whether + ;; the version of grep installed supports "-P". + ;; NOTE: For some reason, when "-execdir" is used, the callback function is never + ;; called, even though the process terminates and its buffer has the correct + ;; output. It works correctly when "-exec" is used, so we use that. + (list "-exec" "grep" "-bPH" + (when magit-todos-ignore-case + "--ignore-case") + extra-args + search-regexp "{}" "+")))) + +;;;;; Set scanner default value + +;; Now that all the scanners have been defined, we can set the value. +(custom-reevaluate-setting 'magit-todos-scanner) + +;;;; Footer + +(provide 'magit-todos) + +;;; magit-todos.el ends here diff --git a/elpa/magit-todos-readme.txt b/elpa/magit-todos-readme.txt new file mode 100644 index 00000000..a5a1f21c --- /dev/null +++ b/elpa/magit-todos-readme.txt @@ -0,0 +1,3 @@ +This package displays keyword entries from source code comments and Org files +in the Magit status buffer. Activating an item jumps to it in its file. By +default, it uses keywords from `hl-todo', minus a few (like "NOTE"). -- 2.47.3