diff lisp/utils/hide-copyleft.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 538048ae2ab8
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/utils/hide-copyleft.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,128 @@
+;;; -*- Mode:Emacs-Lisp -*-
+
+;;; "hide-copyleft.el" by Jamie Zawinski <jwz@lucid.com>, 19-jan-91.
+;;; Last modified  7-sep-91.
+;;;
+;;; 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)
+;;;            (setq emacs-lisp-mode-hook 'hide-copyleft-region
+;;;                  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,")
+    ("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.")
+
+
+(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 max)
+	  (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)))))))
+
+(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)))))
+