cgit.sxemacs.org Git - packages/blob - xemacs-packages/xemacs-devel/hide-copyleft.el

   1 ;;; hide-copyleft.el --- hide obnoxious copyright prologs
   2
   3 ;; Copyright (C) 1997 Sun Microsystems.
   4
   5 ;; This file is part of XEmacs.
   6
   7 ;; XEmacs is free software; you can redistribute it and/or modify it
   8 ;; under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; XEmacs is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  19 ;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA
  20 ;; 02111-1307, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; Written by Jamie Zawinski <jwz@jwz.org>, 19-jan-91.
  25 ;; Minor fixes by Martin Buchholz, 14-may-97.
  26 ;; Last modified  14-may-97.
  27 ;;
  28 ;; I sometimes find it tiresome to have fifteen lines of copyright notice at
  29 ;; the beginning of each file.  Meta-< does not take you to the beginning of
  30 ;; the code, it takes you a windowfull or two away, which can be tedious on
  31 ;; slow terminal lines.
  32 ;;
  33 ;; I know what the copyright notice says; so this code makes all but the first
  34 ;; line of it be invisible, by using Emacs's selective-display feature.  The
  35 ;; text is still present and unmodified, but it is invisible.
  36 ;;
  37 ;; Elide the copyright notice with "Meta-X hide-copyleft-region".  Make it
  38 ;; visible again with "Control-U Meta-X hide-copyleft-region".  Or, if you're
  39 ;; sure you're not gonna get sued, you can do something like this in your
  40 ;; .emacs file:
  41 ;;
  42 ;;       (autoload 'hide-copyleft-region   "hide-copyleft" nil t)
  43 ;;       (autoload 'unhide-copyleft-region "hide-copyleft" nil t)
  44 ;;       (add-hook 'emacs-lisp-mode-hook 'hide-copyleft-region)
  45 ;;       (add-hook 'c-mode-hook 'hide-copyleft-region)
  46 ;;
  47 ;; This code (obviously) has quite specific knowledge of the wording of the
  48 ;; various copyrights I've run across.  Let me know if you find one on which
  49 ;; it fails.
  50
  51 (defgroup hide-copyleft nil
  52   "Hide copyright prologs."
  53   :group 'matching)
  54
  55 (defcustom copylefts-to-hide
  56   ;; There are some extra backslashes in these strings to prevent this code
  57   ;; from matching the definition of this list as the copyright notice!
  58   '(;; GNU
  59     ("free software\; you can redistribute it" .
  60      "notice must be\ preserved on all")
  61     ("free software\; you can redistribute it" .
  62      "copy of the GNU General Public License.*\n?.*\n?.*\n?.*\n?.*\\(02139,\\|02111-1307\\)")
  63     ("distributed in the hope that it will be useful\," .
  64      "notice must be\ preserved on all")
  65     ("free software\; you can redistribute it" .
  66      "General Public License for more details\\.")
  67     ;; X11
  68     ("Permission to use\, copy, modify," .
  69      "WITH THE USE OR PERFORMANCE")
  70     ("Permission to use\, copy, modify," .
  71      "without express or implied warranty")
  72     ;; Motif
  73     ("Copyright.*OPEN\ SOFTWARE FOUNDATION" .
  74      "X Window System is a trademark of the")
  75     ("THIS SOFTWARE\ IS FURNISHED UNDER A LICENSE" .
  76      "X Window System is a trademark of the")
  77     ;; UPenn
  78     ("Permission to use\, copy, and distribute" .
  79      " provided \"as is\" without")
  80     ;; Evans & Sutherland, Solbourne.
  81     ("Copyright 19[0-9][0-9] by " .
  82      "OR PERFORMANCE OF THIS SOFTWARE\\.")
  83     ;; TI Explorer
  84     ("RESTRICTED RIGHTS LEGEND" . "All rights reserved\\.\\(\n;;; ?$\\)?")
  85     ("^%%BeginDocumentation" . "^%%EndDocumentation")
  86     )
  87   "An alist of pairs of regexps which delimit copyright notices to hide.
  88 The first one found is hidden, so order is significant."
  89   :group 'hide-copyleft
  90   :type '(repeat (cons (regexp :tag "Top line")
  91                        (regexp :tag "Bottom line"))))
  92
  93 ;;;###autoload
  94 (defun hide-copyleft-region (&optional arg)
  95   "Make the legal drivel at the front of this file invisible.  Unhide it again
  96 with C-u \\[hide-copyleft-region]."
  97   (interactive "P")
  98   (if arg
  99       (unhide-copyleft-region)
 100     (save-excursion
 101      (save-restriction
 102       (if selective-display (error "selective-display is already on."))
 103       (catch 'Abort
 104         (let ((mod-p (buffer-modified-p))
 105               (buffer-read-only nil)
 106               (rest copylefts-to-hide)
 107               pair start end)
 108           (widen)
 109           (goto-char (point-min))
 110           (while (and rest (not pair))
 111             (save-excursion
 112               (and (re-search-forward (car (car rest)) nil t)
 113                    (setq start (point))
 114                    (re-search-forward (cdr (car rest)) nil t)
 115                    (setq end (point)
 116                          pair (car rest))))
 117             (setq rest (cdr rest)))
 118           (or pair
 119               (if (interactive-p)
 120                   (error "Couldn't find a CopyLeft to hide.")
 121                 (throw 'Abort nil)))
 122           (goto-char end)
 123           (forward-line 1)
 124           ;; If the last line of the notice closes a C comment, don't
 125           ;; hide that line (to avoid confusion...)
 126           (if (save-excursion (forward-char -3) (looking-at "\\*/"))
 127               (forward-line -1))
 128           (setq end (point))
 129           (goto-char start)
 130           (forward-line 1)
 131           (while (< (point) end)
 132             (delete-char -1)
 133             (insert "\^M")
 134             (forward-line 1))
 135           (setq selective-display t)
 136           (set-buffer-modified-p mod-p)))))))
 137
 138 ;;;###autoload
 139 (defun unhide-copyleft-region ()
 140   (interactive)
 141   "If the legal nonsense at the top of this file is elided, make it visible again."
 142   (save-excursion
 143     (save-restriction
 144       (widen)
 145       (goto-char (point-min))
 146       (let ((mod-p (buffer-modified-p))
 147             (buffer-read-only nil)
 148             end)
 149         (or (search-forward "\^M" nil t) (error "Nothing hidden here, dude."))
 150         (end-of-line)
 151         (setq end (point))
 152         (beginning-of-line)
 153         (while (search-forward "\^M" end t)
 154           (delete-char -1)
 155           (insert "\^J"))
 156         (set-buffer-modified-p mod-p)
 157         (setq selective-display nil)))))
 158
 159 (provide 'hide-copyleft)
 160
 161 ;;; hide-copyleft.el ends here