admin/last-chance.el

   1 ;;; last-chance.el --- dangling deterrence     -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2016-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Thien-Thi Nguyen <ttn@gnu.org>
   6 ;; Maintainer: emacs-devel@gnu.org
   7 ;; Keywords: maint
   8 ;; Package: emacs
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Late 2016.  In a recent build, the date in a ChangeLog file
  28 ;; is not fontified.  Turns out the face ‘change-log-date-face’
  29 ;; was declared obsolete since 22.1 and removed 2016-06-23.
  30 ;; (compile "git show c430f7e23fc2c22f251ace4254e37dea1452dfc3")
  31 ;;
  32 ;; This library provides a command ‘last-chance’, which is a small
  33 ;; combination of "git grep" and some regexp filtering.  For example,
  34 ;; if point is on the symbol ‘change-log-date-face’ in the form:
  35 ;;
  36 ;;  (define-obsolete-face-alias 'change-log-date-face ...)
  37 ;;
  38 ;; then:
  39 ;;
  40 ;;  M-x last-chance RET
  41 ;;
  42 ;; will show you any references to ‘change-log-date-face’ in the
  43 ;; *.el files in a new buffer (in Grep mode).  Hopefully you see
  44 ;; only the obsolete declaration and can proceed w/ its removal.
  45 ;; If not, please DTRT and refrain from the removal until those
  46 ;; references are properly transitioned.
  47 ;;
  48 ;; [Insert "nobody reads ChangeLog files" lament, here.  --ttn]
  49
  50 ;;; Code:
  51
  52 (require 'grep)
  53 (require 'thingatpt)
  54
  55 (defvar last-chance-grep-command "git grep -n -H -F -e"
  56   "Command that ends in \"-e\" to do the \"git grep\".
  57 This should include -n, -H, -F.")
  58
  59 (defvar last-chance-uninteresting-regexps
  60   '("ChangeLog[.0-9]*:"
  61     "NEWS[-.0-9]*:"
  62     ;; Add more ‘flush-lines’ args here.
  63     )
  64   "List of regexps that match uninteresting \"git grep\" hits.")
  65
  66 (defvar-local last-chance-symbol nil
  67   "Symbol set by ‘last-chance’ for ‘last-chance-cleanup’ to DTRT.")
  68
  69 (defun last-chance-cleanup (buffer status)
  70   "Filter lines in BUFFER; append STATUS and count of removed lines.
  71 If BUFFER does not seem to be one created by ‘last-chance’, do nothing.
  72 This function is intended to be added to ‘compilation-finish-functions’."
  73   (let ((name (buffer-local-value 'last-chance-symbol buffer))
  74         bef aft)
  75     (when name
  76       (with-current-buffer buffer
  77         (setq bef (count-lines (point-min) (point-max)))
  78         (goto-char (point-min))
  79         (search-forward last-chance-grep-command)
  80         (forward-line 1)
  81         (let ((inhibit-read-only t))
  82           (dolist (re last-chance-uninteresting-regexps)
  83             (flush-lines re))
  84           (keep-lines (format "\\_<%s\\_>" name)))
  85         (setq aft (count-lines (point-min) (point-max)))
  86         (goto-char (point-max))
  87         (insert (format "(status: %s, lines removed: %d)"
  88                         (car (split-string status "\n"))
  89                         (- bef aft)))))))
  90
  91 (defun last-chance (symbol)
  92   "Grep the repo for SYMBOL, filtering the hits.
  93 This uses ‘last-chance-grep-command’ to do the grep and the
  94 regexps in ‘last-chance-uninteresting-regexps’ to filter the hits.
  95 Grepping is recursive starting under the dir that ‘vc-root-dir’
  96 finds (or the default directory if ‘vc-root-dir’ finds nothing).
  97 Output goes to the *grep* buffer.
  98
  99 Interactively, Emacs queries for a symbol,
 100 defaulting to the one at point."
 101   (interactive (list (read (let ((one (symbol-at-point)))
 102                              (when one
 103                                (setq one (symbol-name one)))
 104                              (completing-read
 105                               "Symbol: " obarray
 106                               nil nil
 107                               one nil one)))))
 108   (let ((default-directory (or (vc-root-dir)
 109                                default-directory)))
 110     (grep (format "%s %s"
 111                   last-chance-grep-command
 112                   symbol)))
 113   (setf (buffer-local-value 'last-chance-symbol
 114                             (process-buffer
 115                              (car compilation-in-progress)))
 116         symbol))
 117
 118 (add-to-list 'compilation-finish-functions
 119              'last-chance-cleanup)
 120
 121 (provide 'last-chance)
 122
 123 ;;; last-chance.el ends here