(browse-url-netscape): Fix format for hex escapes.

[gnu-emacs] / lisp / informat.el

diff --git a/lisp/informat.el b/lisp/informat.el
index 1f91cb5b8be54dbdffbc4e97f717c0eb0c2e274c..f96852685f7a1dfeec4db792db06cf2afcfe90d8 100644 (file)
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -1,11 +1,15 @@
-;; Info support functions package for Emacs
+;;; informat.el --- info support functions package for Emacs
+

 ;; Copyright (C) 1986 Free Software Foundation, Inc.
 
 ;; Copyright (C) 1986 Free Software Foundation, Inc.
 

+;; Maintainer: FSF
+;; Keywords: help
+

 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)

 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,


@@ -14,44 +18,108 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Nowadays, the Texinfo formatting commands always tagify a buffer
+;; (as does `makeinfo') since @anchor commands need tag tables.
+
+;;; Code:

 
 (require 'info)
 
 ;;;###autoload
 
 (require 'info)
 
 ;;;###autoload

-(defun Info-tagify ()
-  "Create or update Info-file tag table in current buffer."
+(defun Info-tagify (&optional input-buffer-name)
+  "Create or update Info file tag table in current buffer or in a region."

   (interactive)
   ;; Save and restore point and restrictions.
   ;; save-restrictions would not work
   ;; because it records the old max relative to the end.
   ;; We record it relative to the beginning.
   (interactive)
   ;; Save and restore point and restrictions.
   ;; save-restrictions would not work
   ;; because it records the old max relative to the end.
   ;; We record it relative to the beginning.

-  (message "Tagifying %s ..." (file-name-nondirectory (buffer-file-name)))
+  (if input-buffer-name
+      (message "Tagifying region in %s ..." input-buffer-name)
+      (message
+       "Tagifying %s ..."  (file-name-nondirectory (buffer-file-name))))

   (let ((omin (point-min))
        (omax (point-max))
        (nomax (= (point-max) (1+ (buffer-size))))
        (opoint (point)))
     (unwind-protect
   (let ((omin (point-min))
        (omax (point-max))
        (nomax (= (point-max) (1+ (buffer-size))))
        (opoint (point)))
     (unwind-protect

-       (progn
-         (widen)
-         (goto-char (point-min))
-         (if (search-forward "\^_\nIndirect:\n" nil t)
-             (message "Cannot tagify split info file")
-           (let ((regexp "Node:[ \t]*\\([^,\n\t]\\)*[,\t\n]")
-                 (case-fold-search t)
-                 list)
-             (while (search-forward "\n\^_" nil t)
-               (forward-line 1)
-               (let ((beg (point)))
-                 (forward-line 1)
-                 (if (re-search-backward regexp beg t)
-                     (setq list
-                           (cons (list (buffer-substring
-                                         (match-beginning 1)
-                                         (match-end 1))
-                                       beg)
-                                 list)))))
+    (progn
+      (goto-char (point-min))
+      (if (search-forward "\^_\nIndirect:\n" nil t)
+          (message
+           "Cannot tagify split info file.  Run this before splitting.")
+        (let (tag-list
+              refillp
+              (case-fold-search t)
+              (regexp 
+               (concat
+                "\\("
+
+
+                "\\("
+                "@anchor"        ; match-string 2 matches @anchor
+                "\\)"
+                "\\(-no\\|-yes\\)"  ; match-string 3 matches -no or -yes
+                "\\("
+                "-refill"
+                "\\)"
+
+                "\\("
+                "{"
+                "\\)"
+                "\\("
+                "[^}]+"          ; match-string 6 matches arg to anchor
+                "\\)"
+                "\\("
+                "}"
+                "\\)"
+
+                "\\|"
+
+                "\\("
+                "\n\^_"
+                "\\)"
+
+                "\\("
+                "\nFile:[ \t]*\\([^,\n\t]*\\)[,\t\n]+[ \t\n]*"
+                "Node:[ \t]*"
+                "\\("
+                "[^,\n\t]*"      ; match-string 11 matches arg to node name
+                "\\)"
+                "[,\t\n]"
+                "\\)"
+
+                "\\)"
+                )))
+          (while (re-search-forward regexp nil t)
+            (if (string-equal "@anchor" (match-string 2))
+                (progn
+                  ;; kludge lest lose match-data
+                  (if (string-equal "-yes" (match-string 3))
+                      (setq refillp t))
+                  (setq tag-list
+                        (cons (list
+                               (concat "Ref: " (match-string 6))
+                               (match-beginning 0))
+                              tag-list))
+                  (if (eq refillp t)
+                      ;; set start and end so texinfo-format-refill works
+                      (let ((texinfo-command-start (match-beginning 0))
+                            (texinfo-command-end (match-end 0)))
+                        (texinfo-format-refill))
+                  (delete-region  (match-beginning 0) (match-end 0))))
+              ;; else this is a Node
+              (setq tag-list
+                    (cons (list 
+                           (concat "Node: " (match-string 11))
+                           (match-beginning 0))
+                          tag-list))))
+

              (goto-char (point-max))
              (forward-line -8)
              (let ((buffer-read-only nil))
              (goto-char (point-max))
              (forward-line -8)
              (let ((buffer-read-only nil))


@@ -61,19 +129,24 @@
                      (beginning-of-line)
                      (delete-region (point) end)))
                (goto-char (point-max))
                      (beginning-of-line)
                      (delete-region (point) end)))
                (goto-char (point-max))

-               (insert "\^_\f\nTag table:\n")
-               (move-marker Info-tag-table-marker (point))
-               (setq list (nreverse list))
-               (while list
-                 (insert "Node: " (car (car list)) ?\177)
-                 (princ (car (cdr (car list))) (current-buffer))
+               (insert "\n\^_\f\nTag table:\n")
+               (if (eq major-mode 'info-mode)
+                   (move-marker Info-tag-table-marker (point)))
+               (setq tag-list (nreverse tag-list))
+               (while tag-list
+                 (insert (car (car tag-list)) ?\177)
+                 (princ (car (cdr (car tag-list))) (current-buffer))

                  (insert ?\n)
                  (insert ?\n)

-                 (setq list (cdr list)))
+                 (setq tag-list (cdr tag-list)))

                (insert "\^_\nEnd tag table\n")))))
       (goto-char opoint)
       (narrow-to-region omin (if nomax (1+ (buffer-size))
                               (min omax (point-max))))))
                (insert "\^_\nEnd tag table\n")))))
       (goto-char opoint)
       (narrow-to-region omin (if nomax (1+ (buffer-size))
                               (min omax (point-max))))))

-  (message "Tagifying %s ... done" (file-name-nondirectory (buffer-file-name))))
+  (if input-buffer-name
+      (message "Tagifying region in %s ..." input-buffer-name)
+      (message
+       "Tagifying %s ..."  (file-name-nondirectory (buffer-file-name)))))
+

 \f
 ;;;###autoload
 (defun Info-split ()
 \f
 ;;;###autoload
 (defun Info-split ()


@@ -135,7 +208,7 @@ contains just the tag table and a directory of subfiles."
     (while subfiles
       (goto-char start)
       (insert (nth 1 (car subfiles))
     (while subfiles
       (goto-char start)
       (insert (nth 1 (car subfiles))

-             (format ": %d" (car (car subfiles)))
+             (format ": %d" (1- (car (car subfiles))))

              "\n")
       (setq subfiles (cdr subfiles)))
     (goto-char start)
              "\n")
       (setq subfiles (cdr subfiles)))
     (goto-char start)


@@ -143,6 +216,10 @@ contains just the tag table and a directory of subfiles."
     (search-forward "\nTag Table:\n")
     (insert "(Indirect)\n")))
 \f
     (search-forward "\nTag Table:\n")
     (insert "(Indirect)\n")))
 \f

+(defvar Info-validate-allnodes)
+(defvar Info-validate-thisnode)
+(defvar Info-validate-lossages)
+

 ;;;###autoload
 (defun Info-validate ()
   "Check current buffer for validity as an Info file.
 ;;;###autoload
 (defun Info-validate ()
   "Check current buffer for validity as an Info file.


@@ -156,76 +233,77 @@ Check that every node pointer points to an existing node."
          (error "Don't yet know how to validate indirect info files: \"%s\""
                 (buffer-name (current-buffer))))
       (goto-char (point-min))
          (error "Don't yet know how to validate indirect info files: \"%s\""
                 (buffer-name (current-buffer))))
       (goto-char (point-min))

-      (let ((allnodes '(("*")))
+      (let ((Info-validate-allnodes '(("*")))

            (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
            (case-fold-search t)
            (tags-losing nil)
            (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
            (case-fold-search t)
            (tags-losing nil)

-           (lossages ()))
+           (Info-validate-lossages ()))

        (while (search-forward "\n\^_" nil t)
          (forward-line 1)
          (let ((beg (point)))
            (forward-line 1)
            (if (re-search-backward regexp beg t)
                (let ((name (downcase
        (while (search-forward "\n\^_" nil t)
          (forward-line 1)
          (let ((beg (point)))
            (forward-line 1)
            (if (re-search-backward regexp beg t)
                (let ((name (downcase

-                             (buffer-substring
-                               (match-beginning 1)
-                               (progn
-                                 (goto-char (match-end 1))
-                                 (skip-chars-backward " \t")
-                                 (point))))))
-                 (if (assoc name allnodes)
-                     (setq lossages
+                            (buffer-substring-no-properties
+                             (match-beginning 1)
+                             (progn
+                               (goto-char (match-end 1))
+                               (skip-chars-backward " \t")
+                               (point))))))
+                 (if (assoc name Info-validate-allnodes)
+                     (setq Info-validate-lossages

                            (cons (list name "Duplicate node-name" nil)
                            (cons (list name "Duplicate node-name" nil)

-                                 lossages))
-                     (setq allnodes
-                           (cons (list name
-                                       (progn
-                                         (end-of-line)
-                                         (and (re-search-backward
-                                               "prev[ious]*:" beg t)
-                                              (progn
-                                                (goto-char (match-end 0))
-                                                (downcase
-                                                  (Info-following-node-name)))))
-                                       beg)
-                                 allnodes)))))))
+                                 Info-validate-lossages))
+                   (setq Info-validate-allnodes
+                         (cons (list name
+                                     (progn
+                                       (end-of-line)
+                                       (and (re-search-backward
+                                             "prev[ious]*:" beg t)
+                                            (progn
+                                              (goto-char (match-end 0))
+                                              (downcase
+                                               (Info-following-node-name)))))
+                                     beg)
+                               Info-validate-allnodes)))))))

        (goto-char (point-min))
        (while (search-forward "\n\^_" nil t)
          (forward-line 1)
          (let ((beg (point))
        (goto-char (point-min))
        (while (search-forward "\n\^_" nil t)
          (forward-line 1)
          (let ((beg (point))

-               thisnode next)
+               Info-validate-thisnode next)

            (forward-line 1)
            (if (re-search-backward regexp beg t)
                (save-restriction
                  (search-forward "\n\^_" nil 'move)
                  (narrow-to-region beg (point))
            (forward-line 1)
            (if (re-search-backward regexp beg t)
                (save-restriction
                  (search-forward "\n\^_" nil 'move)
                  (narrow-to-region beg (point))

-                 (setq thisnode (downcase
-                                  (buffer-substring
-                                    (match-beginning 1)
-                                    (progn
-                                      (goto-char (match-end 1))
-                                      (skip-chars-backward " \t")
-                                      (point)))))
+                 (setq Info-validate-thisnode (downcase
+                                               (buffer-substring-no-properties
+                                                (match-beginning 1)
+                                                (progn
+                                                  (goto-char (match-end 1))
+                                                  (skip-chars-backward " \t")
+                                                  (point)))))

                  (end-of-line)
                  (and (search-backward "next:" nil t)
                       (setq next (Info-validate-node-name "invalid Next"))
                  (end-of-line)
                  (and (search-backward "next:" nil t)
                       (setq next (Info-validate-node-name "invalid Next"))

-                      (assoc next allnodes)
-                      (if (equal (car (cdr (assoc next allnodes)))
-                                 thisnode)
+                      (assoc next Info-validate-allnodes)
+                      (if (equal (car (cdr (assoc next Info-validate-allnodes)))
+                                 Info-validate-thisnode)

                           ;; allow multiple `next' pointers to one node
                           ;; allow multiple `next' pointers to one node

-                          (let ((tem lossages))
+                          (let ((tem Info-validate-lossages))

                             (while tem
                               (if (and (equal (car (cdr (car tem)))
                                               "should have Previous")
                                        (equal (car (car tem))
                                               next))
                             (while tem
                               (if (and (equal (car (cdr (car tem)))
                                               "should have Previous")
                                        (equal (car (car tem))
                                               next))

-                                  (setq lossages (delq (car tem) lossages)))
+                                  (setq Info-validate-lossages
+                                        (delq (car tem) Info-validate-lossages)))

                               (setq tem (cdr tem))))
                               (setq tem (cdr tem))))

-                        (setq lossages
+                        (setq Info-validate-lossages

                               (cons (list next
                                           "should have Previous"
                               (cons (list next
                                           "should have Previous"

-                                          thisnode)
-                                    lossages))))
+                                          Info-validate-thisnode)
+                                    Info-validate-lossages))))

                  (end-of-line)
                  (if (re-search-backward "prev[ious]*:" nil t)
                      (Info-validate-node-name "invalid Previous"))
                  (end-of-line)
                  (if (re-search-backward "prev[ious]*:" nil t)
                      (Info-validate-node-name "invalid Previous"))


@@ -235,12 +313,12 @@ Check that every node pointer points to an existing node."
                  (if (re-search-forward "\n* Menu:" nil t)
                      (while (re-search-forward "\n\\* " nil t)
                        (Info-validate-node-name
                  (if (re-search-forward "\n* Menu:" nil t)
                      (while (re-search-forward "\n\\* " nil t)
                        (Info-validate-node-name

-                         (concat "invalid menu item "
-                                 (buffer-substring (point)
-                                                   (save-excursion
-                                                     (skip-chars-forward "^:")
-                                                     (point))))
-                         (Info-extract-menu-node-name))))
+                        (concat "invalid menu item "
+                                (buffer-substring (point)
+                                                  (save-excursion
+                                                    (skip-chars-forward "^:")
+                                                    (point))))
+                        (Info-extract-menu-node-name))))

                  (goto-char (point-min))
                  (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
                    (goto-char (+ (match-beginning 0) 5))
                  (goto-char (point-min))
                  (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
                    (goto-char (+ (match-beginning 0) 5))


@@ -253,29 +331,29 @@ Check that every node pointer points to an existing node."
                                                 (point))))
                     (Info-extract-menu-node-name "Bad format cross-reference")))))))
        (setq tags-losing (not (Info-validate-tags-table)))
                                                 (point))))
                     (Info-extract-menu-node-name "Bad format cross-reference")))))))
        (setq tags-losing (not (Info-validate-tags-table)))

-       (if (or lossages tags-losing)
+       (if (or Info-validate-lossages tags-losing)

            (with-output-to-temp-buffer " *problems in info file*"
            (with-output-to-temp-buffer " *problems in info file*"

-             (while lossages
+             (while Info-validate-lossages

                (princ "In node \"")
                (princ "In node \"")

-               (princ (car (car lossages)))
+               (princ (car (car Info-validate-lossages)))

                (princ "\", ")
                (princ "\", ")

-               (let ((tem (nth 1 (car lossages))))
+               (let ((tem (nth 1 (car Info-validate-lossages))))

                  (cond ((string-match "\n" tem)
                         (princ (substring tem 0 (match-beginning 0)))
                         (princ "..."))
                        (t
                         (princ tem))))
                  (cond ((string-match "\n" tem)
                         (princ (substring tem 0 (match-beginning 0)))
                         (princ "..."))
                        (t
                         (princ tem))))

-               (if (nth 2 (car lossages))
+               (if (nth 2 (car Info-validate-lossages))

                    (progn
                      (princ ": ")
                    (progn
                      (princ ": ")

-                     (let ((tem (nth 2 (car lossages))))
+                     (let ((tem (nth 2 (car Info-validate-lossages))))

                        (cond ((string-match "\n" tem)
                               (princ (substring tem 0 (match-beginning 0)))
                               (princ "..."))
                              (t
                               (princ tem))))))
                (terpri)
                        (cond ((string-match "\n" tem)
                               (princ (substring tem 0 (match-beginning 0)))
                               (princ "..."))
                              (t
                               (princ tem))))))
                (terpri)

-               (setq lossages (cdr lossages)))
+               (setq Info-validate-lossages (cdr Info-validate-lossages)))

              (if tags-losing (princ "\nTags table must be recomputed\n")))
          ;; Here if info file is valid.
          ;; If we already made a list of problems, clear it out.
              (if tags-losing (princ "\nTags table must be recomputed\n")))
          ;; Here if info file is valid.
          ;; If we already made a list of problems, clear it out.


@@ -294,19 +372,20 @@ Check that every node pointer points to an existing node."
     (if (= (following-char) ?\()
        nil
       (setq name
     (if (= (following-char) ?\()
        nil
       (setq name

-           (buffer-substring
+           (buffer-substring-no-properties

             (point)
             (progn
             (point)
             (progn

-             (skip-chars-forward "^,\t\n")
-             (skip-chars-backward " ")
-             (point))))))
+              (skip-chars-forward "^,\t\n")
+              (skip-chars-backward " ")
+              (point))))))

   (if (null name)
       nil
     (setq name (downcase name))
     (or (and (> (length name) 0) (= (aref name 0) ?\())
   (if (null name)
       nil
     (setq name (downcase name))
     (or (and (> (length name) 0) (= (aref name 0) ?\())

-       (assoc name allnodes)
-       (setq lossages
-             (cons (list thisnode kind name) lossages))))
+       (assoc name Info-validate-allnodes)
+       (setq Info-validate-lossages
+             (cons (list Info-validate-thisnode kind name)
+                   Info-validate-lossages))))

   name)
 
 (defun Info-validate-tags-table ()
   name)
 
 (defun Info-validate-tags-table ()


@@ -318,7 +397,7 @@ Check that every node pointer points to an existing node."
                  (start (progn (search-backward "\nTag table:\n")
                                (1- (match-end 0))))
                  tem)
                  (start (progn (search-backward "\nTag table:\n")
                                (1- (match-end 0))))
                  tem)

-            (setq tem allnodes)
+            (setq tem Info-validate-allnodes)

             (while tem
               (goto-char start)
               (or (equal (car (car tem)) "*")
             (while tem
               (goto-char start)
               (or (equal (car (car tem)) "*")


@@ -330,18 +409,20 @@ Check that every node pointer points to an existing node."
               (setq tem (cdr tem)))
             (goto-char (1+ start))
             (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$")
               (setq tem (cdr tem)))
             (goto-char (1+ start))
             (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$")

-              (setq tem (downcase (buffer-substring
+              (setq tem (downcase (buffer-substring-no-properties

                                     (match-beginning 1)
                                     (match-end 1))))
                                     (match-beginning 1)
                                     (match-end 1))))

-              (setq tem (assoc tem allnodes))
+              (setq tem (assoc tem Info-validate-allnodes))

               (if (or (not tem)
                       (< 1000 (progn
                                 (goto-char (match-beginning 2))
                                 (setq tem (- (car (cdr (cdr tem)))
                                              (read (current-buffer))))
                                 (if (> tem 0) tem (- tem)))))
               (if (or (not tem)
                       (< 1000 (progn
                                 (goto-char (match-beginning 2))
                                 (setq tem (- (car (cdr (cdr tem)))
                                              (read (current-buffer))))
                                 (if (> tem 0) tem (- tem)))))

-                  (throw 'losing 'y)))
-            (forward-line 1))
+                  (throw 'losing 'y))
+              (forward-line 1)))
+          (if (looking-at "\^_\n")
+              (forward-line 1))

           (or (looking-at "End tag table\n")
               (throw 'losing 'z))
           nil))))
           (or (looking-at "End tag table\n")
               (throw 'losing 'z))
           nil))))


@@ -392,7 +473,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
                        ((< (point-max) 30000)
                         (message "%s too small to bother tagifying" file))
                        (t
                        ((< (point-max) 30000)
                         (message "%s too small to bother tagifying" file))
                        (t

-                        (Info-tagify file))))
+                        (Info-tagify))))

                (let ((loss-name " *problems in info file*"))
                  (message "Checking validity of info file %s..." file)
                  (if (get-buffer loss-name)
                (let ((loss-name " *problems in info file*"))
                  (message "Checking validity of info file %s..." file)
                  (if (get-buffer loss-name)


@@ -404,7 +485,8 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
                    (message ">> PROBLEMS IN INFO FILE %s" file)
                    (save-excursion
                      (set-buffer loss-name)
                    (message ">> PROBLEMS IN INFO FILE %s" file)
                    (save-excursion
                      (set-buffer loss-name)

-                     (princ (buffer-substring (point-min) (point-max))))
+                     (princ (buffer-substring-no-properties
+                             (point-min) (point-max))))

                    (message "----------------------------------------------------------------------")
                    (setq error 1 lose t)))
                (if (and (buffer-modified-p)
                    (message "----------------------------------------------------------------------")
                    (setq error 1 lose t)))
                (if (and (buffer-modified-p)


@@ -413,3 +495,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
                           (save-buffer))))
            (error (message ">> Error: %s" (prin1-to-string err))))))
       (kill-emacs error))))
                           (save-buffer))))
            (error (message ">> Error: %s" (prin1-to-string err))))))
       (kill-emacs error))))

+
+(provide 'informat)
+
+;;; informat.el ends here