File: hide-copyleft.el

package info (click to toggle)
xemacs20 20.4-13
  • links: PTS
  • area: main
  • in suites: slink
  • size: 67,324 kB
  • ctags: 57,643
  • sloc: lisp: 586,197; ansic: 184,662; sh: 4,296; asm: 3,179; makefile: 2,021; perl: 1,059; csh: 96; sed: 22
file content (152 lines) | stat: -rw-r--r-- 5,573 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
;;; hide-copyleft.el --- hide obnoxious copyright prologs

;; Copyright (C) 1997 Sun Microsystems.

;; This file is part of XEmacs.

;; XEmacs 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 2, or (at your option)
;; any later version.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Commentary:

;; Written by Jamie Zawinski <jwz@netscape.com>, 19-jan-91.
;; Minor fixes by Martin Buchholz, 14-may-97.
;; Last modified  14-may-97.
;;
;; I sometimes find it tiresome to have fifteen lines of copyright notice at
;; the beginning of each file.  Meta-< does not take you to the beginning of
;; the code, it takes you a windowfull or two away, which can be tedious on
;; slow terminal lines.
;;
;; I know what the copyright notice says; so this code makes all but the first
;; line of it be invisible, by using Emacs's selective-display feature.  The
;; text is still present and unmodified, but it is invisible.
;;
;; Elide the copyright notice with "Meta-X hide-copyleft-region".  Make it
;; visible again with "Control-U Meta-X hide-copyleft-region".  Or, if you're
;; sure you're not gonna get sued, you can do something like this in your
;; .emacs file:
;;
;;       (autoload 'hide-copyleft-region   "hide-copyleft" nil t)
;;       (autoload 'unhide-copyleft-region "hide-copyleft" nil t)
;;       (add-hook 'emacs-lisp-mode-hook 'hide-copyleft-region)
;;       (add-hook 'c-mode-hook 'hide-copyleft-region)
;;
;; This code (obviously) has quite specific knowledge of the wording of the 
;; various copyrights I've run across.  Let me know if you find one on which
;; it fails.

(defvar copylefts-to-hide
  ;; There are some extra backslashes in these strings to prevent this code
  ;; from matching the definition of this list as the copyright notice!
  '(;; GNU
    ("free software\; you can redistribute it" .
     "notice must be\ preserved on all")
    ("free software\; you can redistribute it" .
     "copy of the GNU General Public License.*\n?.*\n?.*\n?.*\n?.*\\(02139,\\|02111-1307\\)")
    ("distributed in the hope that it will be useful\," .
     "notice must be\ preserved on all")
    ("free software\; you can redistribute it" .
     "General Public License for more details\\.")
    ;; X11
    ("Permission to use\, copy, modify," .
     "WITH THE USE OR PERFORMANCE")
    ("Permission to use\, copy, modify," .
     "without express or implied warranty")
    ;; Motif
    ("Copyright.*OPEN\ SOFTWARE FOUNDATION" .
     "X Window System is a trademark of the")
    ("THIS SOFTWARE\ IS FURNISHED UNDER A LICENSE" .
     "X Window System is a trademark of the")
    ;; UPenn
    ("Permission to use\, copy, and distribute" .
     " provided \"as is\" without")
    ;; Evans & Sutherland, Solbourne.
    ("Copyright 19[0-9][0-9] by " .
     "OR PERFORMANCE OF THIS SOFTWARE\\.")
    ;; TI Explorer
    ("RESTRICTED RIGHTS LEGEND" . "All rights reserved\\.\\(\n;;; ?$\\)?")
    ("^%%BeginDocumentation" . "^%%EndDocumentation")
    )
  "An alist of pairs of regexps which delimit copyright notices to hide.
The first one found is hidden, so order is significant.")


;;;###autoload
(defun hide-copyleft-region (&optional arg)
  "Make the legal drivel at the front of this file invisible.  Unhide it again
with C-u \\[hide-copyleft-region]."
  (interactive "P")
  (if arg
      (unhide-copyleft-region)
    (save-excursion
     (save-restriction
      (if selective-display (error "selective-display is already on."))
      (catch 'Abort
	(let ((mod-p (buffer-modified-p))
	      (buffer-read-only nil)
	      (rest copylefts-to-hide)
	      pair start end)
	  (widen)
	  (goto-char (point-min))
	  (while (and rest (not pair))
	    (save-excursion
	      (and (re-search-forward (car (car rest)) nil t)
		   (setq start (point))
		   (re-search-forward (cdr (car rest)) nil t)
		   (setq end (point)
			 pair (car rest))))
	    (setq rest (cdr rest)))
	  (setq x pair)
	  (or pair
	      (if (interactive-p)
		  (error "Couldn't find a CopyLeft to hide.")
		(throw 'Abort nil)))
	  (goto-char end)
	  (forward-line 1)
	  ;; If the last line of the notice closes a C comment, don't
	  ;; hide that line (to avoid confusion...)
	  (if (save-excursion (forward-char -3) (looking-at "\\*/"))
	      (forward-line -1))
	  (setq end (point))
	  (goto-char start)
	  (forward-line 1)
	  (while (< (point) end)
	    (delete-char -1)
	    (insert "\^M")
	    (forward-line 1))
	  (setq selective-display t)
	  (set-buffer-modified-p mod-p)))))))

;;;###autoload
(defun unhide-copyleft-region ()
  "If the legal nonsense at the top of this file is elided, make it visible again."
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (let ((mod-p (buffer-modified-p))
	    (buffer-read-only nil)
	    end)
	(or (search-forward "\^M" nil t) (error "Nothing hidden here, dude."))
	(end-of-line)
	(setq end (point))
	(beginning-of-line)
	(while (search-forward "\^M" end t)
	  (delete-char -1)
	  (insert "\^J"))
	(set-buffer-modified-p mod-p)
	(setq selective-display nil)))))