lisp/elide-head.el

   1 ;;; elide-head.el --- hide headers in files
   2
   3 ;; Copyright (C) 1999, 2001-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Dave Love <fx@gnu.org>
   6 ;; Keywords: outlines tools
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Functionality for eliding boilerplate text (normally copyright
  26 ;; notices) in file headers to avoid clutter when you know what it
  27 ;; says.
  28 ;;
  29 ;; `elide-head-headers-to-hide' controls what is elided by the command
  30 ;; `elide-head'.  A buffer-local invisible overlay manages the
  31 ;; elision.
  32
  33 ;; You might add `elide-head' to appropriate major mode hooks or to
  34 ;; `find-file-hook'.  Please do not do this in site init files.  If
  35 ;; you do, information may be hidden from users who don't know it
  36 ;; already.
  37
  38 ;; Note that `hs-minor-mode' will do a similar job by default, but
  39 ;; it's not selective about what leading commentary it hides.
  40
  41 ;; Inspired by jwz's hide-copyleft.el, for which we don't have an
  42 ;; assignment.
  43
  44 ;;; Code:
  45
  46 (defgroup elide-head nil
  47   "Eliding copyright headers and the like in source files."
  48   :version "21.1"
  49   :prefix "elide-head"
  50   :group 'tools)
  51
  52 (defcustom elide-head-headers-to-hide
  53   '(("is free software[:;] you can redistribute it" . ; GNU boilerplate
  54      "\\(Boston, MA 0211\\(1-1307\\|0-1301\\), USA\\|\
  55 If not, see <http://www\\.gnu\\.org/licenses/>\\)\\.")
  56     ("The Regents of the University of California\\.  All rights reserved\\." .
  57      "SUCH DAMAGE\\.")                                ; BSD
  58     ("Permission is hereby granted, free of charge" . ; X11
  59      "authorization from the X Consortium\\."))
  60   "Alist of regexps defining start end end of text to elide.
  61
  62 The cars of elements of the list are searched for in order.  Text is
  63 elided with an invisible overlay from the end of the line where the
  64 first match is found to the end of the match for the corresponding
  65 cdr."
  66   :group 'elide-head
  67   :type '(alist :key-type  (string :tag "Start regexp")
  68                 :value-type (string :tag "End regexp")))
  69
  70 (defvar elide-head-overlay nil)
  71 (make-variable-buffer-local 'elide-head-overlay)
  72
  73 ;;;###autoload
  74 (defun elide-head (&optional arg)
  75   "Hide header material in buffer according to `elide-head-headers-to-hide'.
  76
  77 The header is made invisible with an overlay.  With a prefix arg, show
  78 an elided material again.
  79
  80 This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
  81   (interactive "P")
  82   (if arg
  83       (elide-head-show)
  84     (save-excursion
  85       (save-restriction
  86         (let ((rest elide-head-headers-to-hide)
  87               beg end)
  88           (widen)
  89           (goto-char (point-min))
  90           (while rest
  91             (save-excursion
  92               (when (re-search-forward (caar rest) nil t)
  93                 (setq beg (point))
  94                 (when (re-search-forward (cdar rest) nil t)
  95                   (setq end (point-marker)
  96                         rest nil))))
  97             (if rest (setq rest (cdr rest))))
  98           (if (not (and beg end))
  99               (if (called-interactively-p 'interactive)
 100                   (message "No header found"))
 101             (goto-char beg)
 102             (end-of-line)
 103             (if (overlayp elide-head-overlay)
 104                 (move-overlay elide-head-overlay (point-marker) end)
 105               (setq elide-head-overlay (make-overlay (point-marker) end)))
 106             (overlay-put elide-head-overlay 'invisible t)
 107             (overlay-put elide-head-overlay 'evaporate t)
 108             (overlay-put elide-head-overlay 'after-string "...")))))))
 109
 110 (defun elide-head-show ()
 111   "Show a header elided current buffer by \\[elide-head]."
 112   (interactive)
 113   (if (and (overlayp elide-head-overlay)
 114            (overlay-buffer elide-head-overlay))
 115       (delete-overlay elide-head-overlay)
 116     (if (called-interactively-p 'interactive)
 117         (message "No header hidden"))))
 118
 119 (provide 'elide-head)
 120
 121 ;;; elide-head.el ends here