X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/93e7ada98147db1b93e3009278687ef03771bdbe..a2236dc611360edfb8f5f891b4e63d586793f38f:/lisp/informat.el

diff --git a/lisp/informat.el b/lisp/informat.el
index 36a9bf1113..f96852685f 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -22,45 +22,104 @@
 ;; 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
-(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.
-  (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
-	(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)
-		;; We want the 0-origin character position of the ^_.
-		;; That is the same as the Emacs (1-origin) position
-		;; of the newline before it.
-		(let ((beg (match-beginning 0)))
-		  (forward-line 2)
-		  (if (re-search-backward regexp beg t)
-		      (setq list
-			    (cons (list (buffer-substring-no-properties
-					  (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))
@@ -70,21 +129,24 @@
 		      (beginning-of-line)
 		      (delete-region (point) end)))
 		(goto-char (point-max))
-		(insert "\^_\f\nTag table:\n")
+		(insert "\n\^_\f\nTag table:\n")
 		(if (eq major-mode 'info-mode)
 		    (move-marker Info-tag-table-marker (point)))
-		(setq list (nreverse list))
-		(while list
-		  (insert "Node: " (car (car list)) ?\177)
-		  (princ (position-bytes (car (cdr (car list))))
-			 (current-buffer))
+		(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)
-		  (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))))))
-  (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)))))
+
 
 ;;;###autoload
 (defun Info-split ()
@@ -107,8 +169,7 @@ contains just the tag table and a directory of subfiles."
   (search-forward "\^_")
   (forward-char -1)
   (let ((start (point))
-	(start-byte (position-bytes (point)))
-	(bytes-deleted 0)
+	(chars-deleted 0)
 	subfiles
 	(subfile-number 1)
 	(case-fold-search t)
@@ -130,7 +191,7 @@ contains just the tag table and a directory of subfiles."
 	(goto-char (min (+ (point) 50000) (point-max)))
 	(search-forward "\^_" nil 'move)
 	(setq subfiles
-	      (cons (list (+ start-byte bytes-deleted)
+	      (cons (list (+ start chars-deleted)
 			  (concat (file-name-nondirectory filename)
 				  (format "-%d" subfile-number)))
 		    subfiles))
@@ -141,8 +202,7 @@ contains just the tag table and a directory of subfiles."
 	(delete-region (1- (point)) (point))
 	;; Back up over the final ^_.
 	(forward-char -1)
-	(setq bytes-deleted (+ bytes-deleted (- (position-bytes (point))
-						start-byte)))
+	(setq chars-deleted (+ chars-deleted (- (point) start)))
 	(delete-region start (point))
 	(setq subfile-number (1+ subfile-number))))
     (while subfiles