Synch to No Gnus 200409210948.
[elisp/gnus.git-] / texi / infohack.el
index 3c173ba..31fd019 100644 (file)
@@ -1,5 +1,5 @@
 ;;; infohack.el --- a hack to format info file.
-;; Copyright (C)  2001  Free Software Foundation, Inc.
+;; Copyright (C)  2001, 2003, 2004  Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: info
 
 ;;; Code:
 
-(let ((default-directory (expand-file-name "../lisp/"))
-      (features (cons 'w3-forms (copy-sequence features))))
+(let ((default-directory (expand-file-name "../lisp/")))
   ;; Adjust `load-path' for APEL.
-  (load-file "dgnushack.el"))
+  (load-file "dgnushack.el")
+  ;; Replace "./" with "../lisp/" in `load-path'.
+  (setq load-path (mapcar 'expand-file-name load-path)))
 (load-file (expand-file-name "ptexinfmt.el" "./"))
 
+(if (fboundp 'texinfo-copying)
+    nil
+  ;; Support @copying and @insertcopying for Emacs 21.3 and lesser and
+  ;; XEmacs.
+  (defvar texinfo-copying-text ""
+    "Text of the copyright notice and copying permissions.")
+
+  (defun texinfo-copying ()
+    "Copy the copyright notice and copying permissions from the Texinfo file,
+as indicated by the @copying ... @end copying command;
+insert the text with the @insertcopying command."
+    (let ((beg (progn (beginning-of-line) (point)))
+         (end  (progn (re-search-forward "^@end copying[ \t]*\n") (point))))
+      (setq texinfo-copying-text
+           (buffer-substring-no-properties
+            (save-excursion (goto-char beg) (forward-line 1) (point))
+            (save-excursion (goto-char end) (forward-line -1) (point))))
+      (delete-region beg end)))
+
+  (defun texinfo-insertcopying ()
+    "Insert the copyright notice and copying permissions from the Texinfo file,
+which are indicated by the @copying ... @end copying command."
+    (insert (concat "\n" texinfo-copying-text)))
+
+  (defadvice texinfo-format-scan (before expand-@copying-section activate)
+    "Extract @copying and replace @insertcopying with it."
+    (goto-char (point-min))
+    (when (search-forward "@copying" nil t)
+      (texinfo-copying))
+    (while (search-forward "@insertcopying" nil t)
+      (delete-region (match-beginning 0) (match-end 0))
+      (texinfo-insertcopying))))
+
 (defun infohack-remove-unsupported ()
   (goto-char (point-min))
   (while (re-search-forward "@\\(end \\)?ifnottex" nil t)
   (let ((dest-directory default-directory)
        (max-lisp-eval-depth (max max-lisp-eval-depth 600))
        coding-system)
+    ;; Emacs 21.3 doesn't support @documentencoding
+    (unless (get 'documentencoding 'texinfo-format)
+      (put 'documentencoding 'texinfo-format 
+          'texinfo-discard-line-with-args))
     (find-file file)
     (setq buffer-read-only nil)
-    (setq coding-system (if (boundp 'buffer-file-coding-system)
-                           buffer-file-coding-system
-                         file-coding-system))
+    (setq coding-system buffer-file-coding-system)
     (infohack-remove-unsupported)
     (texinfo-every-node-update)
     (texinfo-format-buffer t) ;; Don't save any file.
@@ -56,8 +92,7 @@
     (setq buffer-file-name
          (expand-file-name (file-name-nondirectory buffer-file-name)
                            default-directory))
-    (setq buffer-file-coding-system coding-system
-         file-coding-system coding-system)
+    (setq buffer-file-coding-system coding-system)
     (if (> (buffer-size) 100000)
        (Info-split))
     (save-buffer)))
@@ -90,36 +125,19 @@ Both characters must have the same length of multi-byte form."
   (setq command-line-args-left nil))
 
 \f
+(require 'bytecomp)
+
 (defun infohack-texi-format (file &optional addsuffix)
   (let ((auto-save-default nil)
        (find-file-run-dired nil)
        coding-system-for-write
-       output-coding-system
        (error 0))
     (condition-case err
        (progn
          (find-file file)
          (setq buffer-read-only nil)
          (buffer-disable-undo (current-buffer))
-         (if (boundp 'MULE)
-             (setq output-coding-system file-coding-system)
-           (setq coding-system-for-write buffer-file-coding-system))
-         ;; Remove ignored areas first.
-         (while (re-search-forward "^@ignore[\t\r ]*$" nil t)
-           (delete-region (match-beginning 0)
-                          (if (re-search-forward
-                               "^@end[\t ]+ignore[\t\r ]*$" nil t)
-                              (1+ (match-end 0))
-                            (point-max))))
-         (infohack-remove-unsupported)
-         (goto-char (point-min))
-         ;; Add suffix if it is needed.
-         (when (and addsuffix
-                    (re-search-forward "^@setfilename[\t ]+\\([^\t\n ]+\\)"
-                                       nil t)
-                    (not (string-match "\\.info$" (match-string 1))))
-           (insert ".info")
-           (goto-char (point-min)))
+         (setq coding-system-for-write buffer-file-coding-system)
          ;; process @include before updating node
          ;; This might produce some problem if we use @lowersection or
          ;; such.
@@ -152,11 +170,41 @@ Both characters must have the same length of multi-byte form."
                          (delete-region (point) (save-excursion
                                                   (forward-line 1)
                                                   (point))))))))))
+         ;; Remove ignored areas.
+         (goto-char (point-min))
+         (while (re-search-forward "^@ignore[\t\r ]*$" nil t)
+           (delete-region (match-beginning 0)
+                          (if (re-search-forward
+                               "^@end[\t ]+ignore[\t\r ]*$" nil t)
+                              (1+ (match-end 0))
+                            (point-max))))
+         ;; Remove unsupported commands.
+         (infohack-remove-unsupported)
+         ;; Add suffix if it is needed.
+         (goto-char (point-min))
+         (when (and addsuffix
+                    (re-search-forward "^@setfilename[\t ]+\\([^\t\n ]+\\)"
+                                       nil t)
+                    (not (string-match "\\.info$" (match-string 1))))
+           (insert ".info"))
          (texinfo-mode)
          (texinfo-every-node-update)
          (set-buffer-modified-p nil)
          (message "texinfo formatting %s..." file)
-         (texinfo-format-buffer nil)
+         (if (featurep 'mule)
+             ;; Encode messages to terminal.
+             (let ((si:message (symbol-function 'message)))
+               (fset 'message
+                     (byte-compile
+                      `(lambda (fmt &rest args)
+                         (funcall ,si:message "%s"
+                                  (encode-coding-string
+                                   (apply 'format fmt args)
+                                   'iso-2022-7bit)))))
+               (unwind-protect
+                   (texinfo-format-buffer nil)
+                 (fset 'message si:message)))
+           (texinfo-format-buffer nil))
          (if (buffer-modified-p)
              (progn (message "Saving modified %s" (buffer-file-name))
                     (save-buffer))))