comparison lisp/informat.el @ 22693:4f2282284e2a

(Info-tagify): Finish previous change. Fix up some messages.
author Richard M. Stallman <rms@gnu.org>
date Mon, 06 Jul 1998 00:03:29 +0000
parents 1614e05bf2b5
children dde5fcbfa2af
comparison
equal deleted inserted replaced
22692:578a6d997580 22693:4f2282284e2a
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the 21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Commentary:
26
27 ;; Nowadays, the Texinfo formatting commands always tagify a buffer
28 ;; (as does `makeinfo') since @anchor commands need tag tables.
29
25 ;;; Code: 30 ;;; Code:
26 31
27 (require 'info) 32 (require 'info)
28 33
29 ;;;###autoload 34 ;;;###autoload
30 (defun Info-tagify () 35 (defun Info-tagify (&optional input-buffer-name)
31 "Create or update Info file tag table in current buffer." 36 "Create or update Info file tag table in current buffer or in a region."
32 (interactive) 37 (interactive)
33 ;; Save and restore point and restrictions. 38 ;; Save and restore point and restrictions.
34 ;; save-restrictions would not work 39 ;; save-restrictions would not work
35 ;; because it records the old max relative to the end. 40 ;; because it records the old max relative to the end.
36 ;; We record it relative to the beginning. 41 ;; We record it relative to the beginning.
37 (message "Tagifying %s ..." (file-name-nondirectory (buffer-file-name))) 42 (if input-buffer-name
43 (message "Tagifying region in %s ..." input-buffer-name)
44 (message
45 "Tagifying %s ..." (file-name-nondirectory (buffer-file-name))))
38 (let ((omin (point-min)) 46 (let ((omin (point-min))
39 (omax (point-max)) 47 (omax (point-max))
40 (nomax (= (point-max) (1+ (buffer-size)))) 48 (nomax (= (point-max) (1+ (buffer-size))))
41 (opoint (point))) 49 (opoint (point)))
42 (unwind-protect 50 (unwind-protect
43 (progn 51 (progn
44 (widen)
45 (goto-char (point-min)) 52 (goto-char (point-min))
46 (if (search-forward "\^_\nIndirect:\n" nil t) 53 (if (search-forward "\^_\nIndirect:\n" nil t)
47 (message "Cannot tagify split info file") 54 (message
48 55 "Cannot tagify split info file. Run this before splitting.")
49 (let (tag-list 56 (let (tag-list
50 refillp 57 refillp
51 (case-fold-search t) 58 (case-fold-search t)
52 (regexp 59 (regexp
53 (concat 60 (concat
120 (let ((end (point))) 127 (let ((end (point)))
121 (search-backward "\nTag table:\n") 128 (search-backward "\nTag table:\n")
122 (beginning-of-line) 129 (beginning-of-line)
123 (delete-region (point) end))) 130 (delete-region (point) end)))
124 (goto-char (point-max)) 131 (goto-char (point-max))
125 (insert "\^_\f\nTag table:\n") 132 (insert "\n\^_\f\nTag table:\n")
126 (if (eq major-mode 'info-mode) 133 (if (eq major-mode 'info-mode)
127 (move-marker Info-tag-table-marker (point))) 134 (move-marker Info-tag-table-marker (point)))
128 (setq tag-list (nreverse tag-list)) 135 (setq tag-list (nreverse tag-list))
129 (while tag-list 136 (while tag-list
130 (insert (car (car tag-list)) ?\177) 137 (insert (car (car tag-list)) ?\177)
131 (princ (position-bytes (car (cdr (car list)))) 138 (princ (car (cdr (car tag-list))) (current-buffer))
132 (current-buffer))
133 (insert ?\n) 139 (insert ?\n)
134 (setq tag-list (cdr tag-list))) 140 (setq tag-list (cdr tag-list)))
135 (insert "\^_\nEnd tag table\n"))))) 141 (insert "\^_\nEnd tag table\n")))))
136 (goto-char opoint) 142 (goto-char opoint)
137 (narrow-to-region omin (if nomax (1+ (buffer-size)) 143 (narrow-to-region omin (if nomax (1+ (buffer-size))
138 (min omax (point-max)))))) 144 (min omax (point-max))))))
139 (message "Tagifying %s ... done" (file-name-nondirectory (buffer-file-name)))) 145 (if input-buffer-name
146 (message "Tagifying region in %s ..." input-buffer-name)
147 (message
148 "Tagifying %s ..." (file-name-nondirectory (buffer-file-name)))))
149
140 150
141 ;;;###autoload 151 ;;;###autoload
142 (defun Info-split () 152 (defun Info-split ()
143 "Split an info file into an indirect file plus bounded-size subfiles. 153 "Split an info file into an indirect file plus bounded-size subfiles.
144 Each subfile will be up to 50,000 characters plus one node. 154 Each subfile will be up to 50,000 characters plus one node.
157 (error "This is too small to be worth splitting")) 167 (error "This is too small to be worth splitting"))
158 (goto-char (point-min)) 168 (goto-char (point-min))
159 (search-forward "\^_") 169 (search-forward "\^_")
160 (forward-char -1) 170 (forward-char -1)
161 (let ((start (point)) 171 (let ((start (point))
162 (start-byte (position-bytes (point))) 172 (chars-deleted 0)
163 (bytes-deleted 0)
164 subfiles 173 subfiles
165 (subfile-number 1) 174 (subfile-number 1)
166 (case-fold-search t) 175 (case-fold-search t)
167 (filename (file-name-sans-versions buffer-file-name))) 176 (filename (file-name-sans-versions buffer-file-name)))
168 (goto-char (point-max)) 177 (goto-char (point-max))
180 (goto-char (point-min)) 189 (goto-char (point-min))
181 (while (< (1+ (point)) (point-max)) 190 (while (< (1+ (point)) (point-max))
182 (goto-char (min (+ (point) 50000) (point-max))) 191 (goto-char (min (+ (point) 50000) (point-max)))
183 (search-forward "\^_" nil 'move) 192 (search-forward "\^_" nil 'move)
184 (setq subfiles 193 (setq subfiles
185 (cons (list (+ start-byte bytes-deleted) 194 (cons (list (+ start chars-deleted)
186 (concat (file-name-nondirectory filename) 195 (concat (file-name-nondirectory filename)
187 (format "-%d" subfile-number))) 196 (format "-%d" subfile-number)))
188 subfiles)) 197 subfiles))
189 ;; Put a newline at end of split file, to make Unix happier. 198 ;; Put a newline at end of split file, to make Unix happier.
190 (insert "\n") 199 (insert "\n")
191 (write-region (point-min) (point) 200 (write-region (point-min) (point)
192 (concat filename (format "-%d" subfile-number))) 201 (concat filename (format "-%d" subfile-number)))
193 (delete-region (1- (point)) (point)) 202 (delete-region (1- (point)) (point))
194 ;; Back up over the final ^_. 203 ;; Back up over the final ^_.
195 (forward-char -1) 204 (forward-char -1)
196 (setq bytes-deleted (+ bytes-deleted (- (position-bytes (point)) 205 (setq chars-deleted (+ chars-deleted (- (point) start)))
197 start-byte)))
198 (delete-region start (point)) 206 (delete-region start (point))
199 (setq subfile-number (1+ subfile-number)))) 207 (setq subfile-number (1+ subfile-number))))
200 (while subfiles 208 (while subfiles
201 (goto-char start) 209 (goto-char start)
202 (insert (nth 1 (car subfiles)) 210 (insert (nth 1 (car subfiles))