code.delx.au - gnu-emacs-elpa/blob - packages/compact-docstrings/compact-docstrings.el

   1 ;;; compact-docstrings.el --- Shrink blank lines in docstrings and doc comments
   2
   3 ;; Copyright (C) 2016  Free Software Foundation, Inc.
   4
   5 ;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
   6 ;; Maintainer: Clément Pit-Claudel <clement.pitclaudel@live.com>
   7 ;; URL: https://github.com/cpitclaudel/compact-docstrings
   8 ;; Package-Version: 0.1
   9 ;; Keywords: convenience, faces, lisp, maint, c
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Shrink blank lines in docstrings and doc comments
  27 ;;
  28 ;; Enable locally with `compact-docstrings-mode':
  29 ;;   (add-hook 'some-mode-hook #'compact-docstrings-mode)
  30 ;;
  31 ;; Enable globally (in all programming modes) with
  32 ;;   (add-hook 'after-init-hook #'global-compact-docstrings--mode)
  33
  34 ;;; Code:
  35
  36 (defgroup compact-docstrings nil
  37   "Shrink empty lines in docstrings and doc comments."
  38   :group 'faces)
  39
  40 (defface compact-docstrings-face
  41   '((t :height 0.5))
  42   "Face applied to blank lines in docstrings."
  43   :group 'compact-docstrings)
  44
  45 (defcustom compact-docstrings-only-doc-blocks t
  46   "When nil, also shrink blank lines in regular strings and comments."
  47   :group 'compact-docstrings
  48   :type 'boolean)
  49
  50 (defun compact-docstrings--matcher (bound)
  51   "Find blank line in docstring, looking in point .. BOUND."
  52   (let ((found nil))
  53     (while (and (not found) (re-search-forward "^\\s-*\n" bound t))
  54       (let ((syntax (syntax-ppss)))
  55         (when (and (or (nth 3 syntax)  ;; In string
  56                        (nth 4 syntax)) ;; In comment
  57                    (or (not compact-docstrings-only-doc-blocks)
  58                        (let ((face (get-text-property (point) 'face)))
  59                          (or (eq face 'font-lock-doc-face)
  60                              (and (listp face) (memq 'font-lock-doc-face face))))))
  61           (setq found t))))
  62     found))
  63
  64 (defconst compact-docstrings--keywords
  65   '((compact-docstrings--matcher 0 'compact-docstrings-face prepend)) 'append)
  66
  67 ;;;###autoload
  68 (define-minor-mode compact-docstrings-mode
  69   "Shrink empty lines in docstrings and doc comments."
  70   :lighter " compact"
  71   (if compact-docstrings-mode
  72       (font-lock-add-keywords nil compact-docstrings--keywords 'append)
  73     (font-lock-remove-keywords nil compact-docstrings--keywords))
  74   (if (fboundp #'font-lock-flush)
  75       (font-lock-flush)
  76     (with-no-warnings (font-lock-fontify-buffer))))
  77
  78 (defun compact-docstrings--mode-on ()
  79   "Turn on `compact-docstrings-mode', if appropriate."
  80   (when (derived-mode-p major-mode #'prog-mode)
  81     (compact-docstrings-mode)))
  82
  83 ;;;###autoload
  84 (defalias 'shrink-docstrings #'compact-docstrings--mode-on)
  85
  86 ;;;###autoload
  87 (define-globalized-minor-mode global-compact-docstrings-mode compact-docstrings-mode
  88   compact-docstrings--mode-on
  89   :init-value nil)
  90
  91 (provide 'compact-docstrings)
  92 ;;; compact-docstrings.el ends here