Remove non-free old and crusty clearcase pkg
[packages] / xemacs-packages / gnus / texi / infohack.el
1 ;;; infohack.el --- a hack to format info file.
2 ;; Copyright (C)  2001, 2003, 2004, 2008  Free Software Foundation, Inc.
3
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Keywords: info
6
7 ;; This file is part of GNU Emacs.
8
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3, or (at your option)
12 ;; any later version.
13
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02110-1301, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (require 'texinfmt)
29
30 (if (fboundp 'texinfo-copying)
31     nil
32   ;; Support @copying and @insertcopying for Emacs 21.3 and lesser and
33   ;; XEmacs.
34   (defvar texinfo-copying-text ""
35     "Text of the copyright notice and copying permissions.")
36
37   (defun texinfo-copying ()
38     "Copy the copyright notice and copying permissions from the Texinfo file,
39 as indicated by the @copying ... @end copying command;
40 insert the text with the @insertcopying command."
41     (let ((beg (progn (beginning-of-line) (point)))
42           (end  (progn (re-search-forward "^@end copying[ \t]*\n") (point))))
43       (setq texinfo-copying-text
44             (buffer-substring-no-properties
45              (save-excursion (goto-char beg) (forward-line 1) (point))
46              (save-excursion (goto-char end) (forward-line -1) (point))))
47       (delete-region beg end)))
48
49   (defun texinfo-insertcopying ()
50     "Insert the copyright notice and copying permissions from the Texinfo file,
51 which are indicated by the @copying ... @end copying command."
52     (insert (concat "\n" texinfo-copying-text)))
53
54   (defadvice texinfo-format-scan (before expand-@copying-section activate)
55     "Extract @copying and replace @insertcopying with it."
56     (goto-char (point-min))
57     (when (search-forward "@copying" nil t)
58       (texinfo-copying))
59     (while (search-forward "@insertcopying" nil t)
60       (delete-region (match-beginning 0) (match-end 0))
61       (texinfo-insertcopying))))
62
63 (defun infohack-remove-unsupported ()
64   (goto-char (point-min))
65   (while (re-search-forward "@\\(end \\)?ifnottex" nil t) 
66     (replace-match ""))
67   (goto-char (point-min))
68   (while (search-forward "\n@iflatex\n" nil t)
69     (delete-region (1+ (match-beginning 0))
70                    (search-forward "\n@end iflatex\n"))))
71
72 (defun infohack (file)
73   (let ((dest-directory default-directory)
74         (max-lisp-eval-depth (max max-lisp-eval-depth 600))
75         coding-system)
76     ;; Emacs 21.3 doesn't support @documentencoding
77     (unless (get 'documentencoding 'texinfo-format)
78       (put 'documentencoding 'texinfo-format 
79            'texinfo-discard-line-with-args))
80     (find-file file)
81     (setq buffer-read-only nil)
82     (setq coding-system buffer-file-coding-system)
83     (infohack-remove-unsupported)
84     (texinfo-every-node-update) 
85     (texinfo-format-buffer t) ;; Don't save any file.
86     (setq default-directory dest-directory)
87     (setq buffer-file-name 
88           (expand-file-name (file-name-nondirectory buffer-file-name)
89                             default-directory))
90     (setq buffer-file-coding-system coding-system)
91     (if (> (buffer-size) 100000)
92         (Info-split))
93     (save-buffer)))
94
95 (eval-and-compile
96   (when (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
97                       (symbol-name system-type))
98     (defun subst-char-in-region (START END FROMCHAR TOCHAR &optional NOUNDO)
99       "From START to END, replace FROMCHAR with TOCHAR each time it occurs.
100 If optional arg NOUNDO is non-nil, don't record this change for undo
101 and don't mark the buffer as really changed.
102 Both characters must have the same length of multi-byte form."
103       (let ((original-buffer-undo-list buffer-undo-list)
104             (modified (buffer-modified-p)))
105         (if NOUNDO
106             (setq buffer-undo-list t))
107         (goto-char START)
108         (let ((from (char-to-string FROMCHAR))
109               (to (char-to-string TOCHAR)))
110           (while (search-forward from END t)
111             (replace-match to t t)))
112         (if NOUNDO
113             (progn (setq buffer-undo-list original-buffer-undo-list)
114                    (set-buffer-modidifed-p modified)))))))
115
116 (defun batch-makeinfo ()
117   "Emacs makeinfo in batch mode."
118   (infohack (car command-line-args-left))
119   (setq command-line-args-left nil))
120
121 ;;; arch-tag: 9ca2f71f-b280-48b3-9826-8dc052dfbbfe
122 ;;; infohack.el ends here