Update copyright year to 2016
[gnus] / texi / infohack.el
1 ;;; infohack.el --- a hack to format info file.
2 ;; Copyright (C) 2001-2016 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.  If not, see <http://www.gnu.org/licenses/>.
21
22 ;;; Commentary:
23
24 ;;; Code:
25
26 (require 'texinfmt)
27
28 (if (fboundp 'texinfo-copying)
29     nil
30   ;; Support @copying and @insertcopying for Emacs 21.3 and lesser and
31   ;; XEmacs.
32   (defvar texinfo-copying-text ""
33     "Text of the copyright notice and copying permissions.")
34
35   (defun texinfo-copying ()
36     "Copy the copyright notice and copying permissions from the Texinfo file,
37 as indicated by the @copying ... @end copying command;
38 insert the text with the @insertcopying command."
39     (let ((beg (progn (beginning-of-line) (point)))
40           (end  (progn (re-search-forward "^@end copying[ \t]*\n") (point))))
41       (setq texinfo-copying-text
42             (buffer-substring-no-properties
43              (save-excursion (goto-char beg) (forward-line 1) (point))
44              (save-excursion (goto-char end) (forward-line -1) (point))))
45       (delete-region beg end)))
46
47   (defun texinfo-insertcopying ()
48     "Insert the copyright notice and copying permissions from the Texinfo file,
49 which are indicated by the @copying ... @end copying command."
50     (insert (concat "\n" texinfo-copying-text)))
51
52   (defadvice texinfo-format-scan (before expand-@copying-section activate)
53     "Extract @copying and replace @insertcopying with it."
54     (goto-char (point-min))
55     (when (search-forward "@copying" nil t)
56       (texinfo-copying))
57     (while (search-forward "@insertcopying" nil t)
58       (delete-region (match-beginning 0) (match-end 0))
59       (texinfo-insertcopying))))
60
61 (if (fboundp 'texinfo-format-comma)
62     nil
63   (put 'comma 'texinfo-format 'texinfo-format-comma)
64   (defun texinfo-format-comma ()
65     (texinfo-parse-arg-discard)
66     (insert ",")
67     (put-text-property (1- (point)) (point) 'ignore t))
68
69   ;; Redefine this function so as to work for @comma
70   (defun texinfo-format-parse-args ()
71     (let ((start (1- (point)))
72           next beg end
73           args)
74       (search-forward "{")
75       (save-excursion
76         (texinfo-format-expand-region
77          (point)
78          (save-excursion (up-list 1) (1- (point)))))
79       ;; The following does not handle cross references of the form:
80       ;; `@xref{bullet, , @code{@@bullet}@{@}}.' because the
81       ;; re-search-forward finds the first right brace after the second
82       ;; comma.
83       (while (/= (preceding-char) ?\})
84         (skip-chars-forward " \t\n")
85         (setq beg (point))
86 ;;;     (re-search-forward "[},]")
87         ;; Ignore commas that are derived from @comma{}.
88         (while (and (re-search-forward "[},]" nil t)
89                     (get-text-property (match-beginning 0) 'ignore)))
90 ;;;
91         (setq next (point))
92         (forward-char -1)
93         (skip-chars-backward " \t\n")
94         (setq end (point))
95         (cond ((< beg end)
96                (goto-char beg)
97                (while (search-forward "\n" end t)
98                  (replace-match " "))))
99         (push (if (> end beg) (buffer-substring-no-properties beg end))
100               args)
101         (goto-char next))
102       ;;(if (eolp) (forward-char 1))
103       (setq texinfo-command-end (point))
104       (nreverse args))))
105
106 (defun infohack-remove-unsupported ()
107   (goto-char (point-min))
108   (while (re-search-forward "@\\(end \\)?ifnottex" nil t) 
109     (replace-match ""))
110   (goto-char (point-min))
111   (while (search-forward "\n@iflatex\n" nil t)
112     (delete-region (1+ (match-beginning 0))
113                    (search-forward "\n@end iflatex\n"))))
114
115 (defun infohack-replace-unsupported ()
116   (goto-char (point-min))
117   (while (search-forward "@indicateurl{" nil t)
118     (replace-match "@url{")))
119
120 (defun infohack-include-files ()
121   "Insert @include files."
122   (goto-char (point-min))
123   (set-syntax-table texinfo-format-syntax-table)
124   (let (start texinfo-command-end filename)
125     (while (re-search-forward "^@include" nil t)
126       (setq start (match-beginning 0)
127             texinfo-command-end (point)
128             filename (texinfo-parse-line-arg))
129       (delete-region start (point-at-bol 2))
130       (message "Reading included file: %s" filename)
131       (save-excursion
132         (save-restriction
133           (narrow-to-region
134            (point)
135            (+ (point) (car (cdr (insert-file-contents filename)))))
136           (goto-char (point-min))
137           ;; Remove `@setfilename' line from included file, if any,
138           ;; so @setfilename command not duplicated.
139           (if (re-search-forward "^@setfilename" (point-at-eol 100) t)
140               (delete-region (point-at-bol 1)
141                              (point-at-bol 2))))))))
142
143 (defun infohack (file)
144   (let ((dest-directory default-directory)
145         (max-lisp-eval-depth (max max-lisp-eval-depth 600))
146         coding-system)
147     ;; Emacs 21.3 doesn't support @documentencoding
148     (unless (get 'documentencoding 'texinfo-format)
149       (put 'documentencoding 'texinfo-format 
150            'texinfo-discard-line-with-args))
151     (find-file file)
152     (setq buffer-read-only nil)
153     (setq coding-system buffer-file-coding-system)
154     (infohack-remove-unsupported)
155     (infohack-include-files)
156     (infohack-replace-unsupported)
157     (texinfo-every-node-update) 
158     (texinfo-format-buffer t) ;; Don't save any file.
159     (setq default-directory dest-directory)
160     (setq buffer-file-name 
161           (expand-file-name (file-name-nondirectory buffer-file-name)
162                             default-directory))
163     (setq buffer-file-coding-system coding-system)
164     ;;(if (> (buffer-size) (if (boundp 'Info-split-threshold)
165     ;;                         (+ 50000 Info-split-threshold)
166     ;;                       100000))
167     ;;    (Info-split))
168     (save-buffer)))
169
170 (eval-and-compile
171   (when (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
172                       (symbol-name system-type))
173     (defun subst-char-in-region (START END FROMCHAR TOCHAR &optional NOUNDO)
174       "From START to END, replace FROMCHAR with TOCHAR each time it occurs.
175 If optional arg NOUNDO is non-nil, don't record this change for undo
176 and don't mark the buffer as really changed.
177 Both characters must have the same length of multi-byte form."
178       (let ((original-buffer-undo-list buffer-undo-list)
179             (modified (buffer-modified-p)))
180         (if NOUNDO
181             (setq buffer-undo-list t))
182         (goto-char START)
183         (let ((from (char-to-string FROMCHAR))
184               (to (char-to-string TOCHAR)))
185           (while (search-forward from END t)
186             (replace-match to t t)))
187         (if NOUNDO
188             (progn (setq buffer-undo-list original-buffer-undo-list)
189                    (set-buffer-modidifed-p modified)))))))
190
191 (defun batch-makeinfo ()
192   "Emacs makeinfo in batch mode."
193   (infohack (car command-line-args-left))
194   (setq command-line-args-left nil))
195
196 ;;; infohack.el ends here