Mercurial > hg > xemacs-beta
view lisp/utils/hide-copyleft.el @ 42:8b8b7f3559a2 r19-15b104
Import from CVS: tag r19-15b104
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:54:51 +0200 |
parents | 376386a54a3c |
children | 538048ae2ab8 |
line wrap: on
line source
;;; -*- 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)))))