texinfmt.el

早期freebsd实现

;; Convert texinfo files to info files.
;; Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.

;; 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)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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.


(defvar texinfo-format-syntax-table nil)

(defvar texinfo-vindex)
(defvar texinfo-findex)
(defvar texinfo-cindex)
(defvar texinfo-pindex)
(defvar texinfo-tindex)
(defvar texinfo-kindex)
(defvar texinfo-last-node)
(defvar texinfo-node-names)

(if texinfo-format-syntax-table
    nil
  (setq texinfo-format-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\" " " texinfo-format-syntax-table)
  (modify-syntax-entry ?\\ " " texinfo-format-syntax-table)
  (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table)
  (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table)
  (modify-syntax-entry ?\[ "." texinfo-format-syntax-table)
  (modify-syntax-entry ?\] "." texinfo-format-syntax-table)
  (modify-syntax-entry ?\( "." texinfo-format-syntax-table)
  (modify-syntax-entry ?\) "." texinfo-format-syntax-table)
  (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table)
  (modify-syntax-entry ?} "){" texinfo-format-syntax-table)
  (modify-syntax-entry ?\' "." texinfo-format-syntax-table))

(defun texinfo-format-buffer (&optional notagify)
  "Process the current buffer as texinfo code, into an Info file.
The Info file output is generated in a buffer visiting the Info file
names specified in the @setfilename command.

Non-nil argument (prefix, if interactive) means don't make tag table
and don't split the file if large.  You can use Info-tagify and
Info-split to do these manually."
  (interactive "P")
  (let ((lastmessage "Formatting Info file..."))
    (message lastmessage)
    (texinfo-format-buffer-1)
    (if notagify
	nil
      (if (> (buffer-size) 30000)
	  (progn
	    (message (setq lastmessage "Making tags table for Info file..."))
	    (Info-tagify)))
      (if (> (buffer-size) 100000)
	  (progn
	    (message (setq lastmessage "Splitting Info file..."))
	    (Info-split))))
    (message (concat lastmessage
		     (if (interactive-p) "done.  Now save it." "done.")))))

(defun texinfo-format-buffer-1 ()
  (let (texinfo-format-filename
	texinfo-example-start
	texinfo-command-start
	texinfo-command-end
	texinfo-command-name
	texinfo-last-node
	texinfo-vindex
	texinfo-findex
	texinfo-cindex
	texinfo-pindex
	texinfo-tindex
	texinfo-kindex
	texinfo-stack
	texinfo-node-names
	outfile
	(fill-column fill-column)
	(input-buffer (current-buffer))
	(input-directory default-directory))
    (save-excursion
      (goto-char (point-min))
      (search-forward "@setfilename")
      (setq texinfo-command-end (point))
      (setq outfile (texinfo-parse-line-arg)))
    (find-file outfile)
    (texinfo-mode)
    (set-syntax-table texinfo-format-syntax-table)
    (erase-buffer)
    (insert-buffer-substring input-buffer)
    (goto-char (point-min))
    (search-forward "@setfilename")
    (beginning-of-line)
    (delete-region (point-min) (point))
    ;; Remove @bye at end of file, if it is there.
    (goto-char (point-max))
    (if (search-backward "@bye" nil t)
	(delete-region (point) (point-max)))
    ;; Make sure buffer ends in a newline.
    (or (= (preceding-char) ?\n)
	(insert "\n"))
    ;; Scan the whole buffer, converting to Info format.
    (texinfo-format-scan)
    ;; Return data for indices.
    (goto-char (point-min))
    (list outfile
	  texinfo-vindex texinfo-findex texinfo-cindex
	  texinfo-pindex texinfo-tindex texinfo-kindex)))

(defvar texinfo-region-buffer-name "*Info Region*"
  "*Name of the temporary buffer used by \\[texinfo-format-region].")

(defun texinfo-format-region (region-beginning region-ending)
  "Convert the the current region of the Texinfo file to Info format.
This lets you see what that part of the file will look like in Info.
The command is bound to \\[texinfo-format-region].  The text that is
converted to Info is stored in a temporary buffer."
  (interactive "r")
  (message "Converting region to Info format...")
  (let (texinfo-command-start
	texinfo-command-end
	texinfo-command-name
	texinfo-vindex
	texinfo-findex
	texinfo-cindex
	texinfo-pindex
	texinfo-tindex
	texinfo-kindex
	texinfo-stack
	texinfo-format-filename
	texinfo-example-start
	texinfo-last-node
	texinfo-node-names
	(fill-column fill-column)
	(input-buffer (current-buffer))
	(input-directory default-directory)
	filename-beginning
	filename-ending)

;;; Find a buffer to use.

    (switch-to-buffer (get-buffer-create texinfo-region-buffer-name))

    ;; Insert the region into the buffer.
    (erase-buffer)

    (save-excursion
      (set-buffer input-buffer)
      (save-excursion
	(save-restriction
	  (widen)
	  (goto-char (point-min))
	  ;; Initialize the buffer with the filename
	  ;; or else explain that a filename is needed.
	  (or (search-forward "@setfilename"
			      (save-excursion (forward-line 100) (point)) t)
	      (error "The texinfo file needs a line saying: @setfilename <name>"))
	  (beginning-of-line)
	  (setq filename-beginning (point))
	  (forward-line 1)
	  (setq filename-ending (point)))))

    ;; Insert the @setfilename line into the buffer.
    (insert-buffer-substring input-buffer
			     (min filename-beginning region-beginning)  
			     filename-ending)
    
    ;; Insert the region into the buffer.
    (insert-buffer-substring input-buffer
			     (max region-beginning filename-ending)
			     region-ending)

    (texinfo-mode)

    ;; Install a syntax table useful for scanning command operands.
    (set-syntax-table texinfo-format-syntax-table)
    
    ;; If the region includes the effective end of the data,
    ;; discard everything after that.
    (goto-char (point-max))
    (if (re-search-backward "^@bye" nil t)
	(delete-region (point) (point-max)))
    ;; Make sure buffer ends in a newline.
    (or (= (preceding-char) ?\n)
	(insert "\n"))

    ;; Now convert for real.
    (goto-char (point-min))
    (texinfo-format-scan)
    (goto-char (point-min)))

  (message "Done."))

;; Perform those texinfo-to-info conversions that apply to the whole input
;; uniformly.
(defun texinfo-format-scan ()
  ;; Convert left and right quotes to typewriter font quotes.
  (goto-char (point-min))
  (while (search-forward "``" nil t)
    (replace-match "\""))
  (goto-char (point-min))
  (while (search-forward "''" nil t)
    (replace-match "\""))
  ;; Scan for @-commands.
  (goto-char (point-min))
  (while (search-forward "@" nil t)
    (if (looking-at "[@{}'` *]")
	;; Handle a few special @-followed-by-one-char commands.
	(if (= (following-char) ?*)
	    ;; @* has no effect, since we are not filling.
	    (delete-region (1- (point)) (1+ (point)))
	  ;; The other characters are simply quoted.  Delete the @.
	  (delete-char -1)
	  (forward-char 1))
      ;; @ is followed by a command-word; find the end of the word.
      (setq texinfo-command-start (1- (point)))
      (if (= (char-syntax (following-char)) ?w)
	  (forward-word 1)
	(forward-char 1))
      (setq texinfo-command-end (point))
      ;; Call the handler for this command.
      (setq texinfo-command-name
	    (intern (buffer-substring (1+ texinfo-command-start)
				      texinfo-command-end)))
      (let ((cmd (get texinfo-command-name 'texinfo-format)))
	(if cmd (funcall cmd)
	  (texinfo-unsupported)))))
  (cond (texinfo-stack
	 (goto-char (nth 2 (car texinfo-stack)))
	 (error "Unterminated @%s" (car (car texinfo-stack))))))

(put 'begin 'texinfo-format 'texinfo-format-begin)
(defun texinfo-format-begin ()
  (texinfo-format-begin-end 'texinfo-format))

(put 'end 'texinfo-format 'texinfo-format-end)
(defun texinfo-format-end ()
  (texinfo-format-begin-end 'texinfo-end))

(defun texinfo-format-begin-end (prop)
  (setq texinfo-command-name (intern (texinfo-parse-line-arg)))
  (setq cmd (get texinfo-command-name prop))
  (if cmd (funcall cmd)
    (texinfo-unsupported)))

(defun texinfo-parse-line-arg ()
  (goto-char texinfo-command-end)
  (let ((start (point)))
    (cond ((looking-at " ")
	   (skip-chars-forward " ")
	   (setq start (point))
	   (end-of-line)
	   (setq texinfo-command-end (1+ (point))))
	  ((looking-at "{")
	   (setq start (1+ (point)))
	   (forward-list 1)
	   (setq texinfo-command-end (point))
	   (forward-char -1))
	  (t
	   (error "Invalid texinfo command arg format")))
    (prog1 (buffer-substring start (point))
	   (if (eolp) (forward-char 1)))))

(defun texinfo-parse-expanded-arg ()
  (goto-char texinfo-command-end)
  (let ((start (point))
	marker)
    (cond ((looking-at " ")
	   (skip-chars-forward " ")
	   (setq start (point))
	   (end-of-line)
	   (setq texinfo-command-end (1+ (point))))
	  ((looking-at "{")
	   (setq start (1+ (point)))
	   (forward-list 1)
	   (setq texinfo-command-end (point))
	   (forward-char -1))
	  (t
	   (error "Invalid texinfo command arg format")))
    (setq marker (move-marker (make-marker) texinfo-command-end))
    (texinfo-format-expand-region start (point))
    (setq texinfo-command-end (marker-position marker))
    (move-marker marker nil)
    (prog1 (buffer-substring start (point))
	   (if (eolp) (forward-char 1)))))

(defun texinfo-format-expand-region (start end)
  (save-restriction
    (narrow-to-region start end)
    (let (texinfo-command-start
	  texinfo-command-end
	  texinfo-command-name
	  texinfo-stack)
      (texinfo-format-scan))
    (goto-char (point-max))))

(defun texinfo-parse-arg-discard ()
  (prog1 (texinfo-parse-line-arg)
	 (texinfo-discard-command)))

(defun texinfo-discard-command ()
  (delete-region texinfo-command-start texinfo-command-end))

(defun texinfo-format-parse-line-args ()
  (let ((start (1- (point)))
	next beg end
	args)
    (skip-chars-forward " ")
    (while (not (eolp))
      (setq beg (point))
      (re-search-forward "[\n,]")
      (setq next (point))
      (if (bolp) (setq next (1- next)))
      (forward-char -1)
      (skip-chars-backward " ")
      (setq end (point))
      (setq args (cons (if (> end beg) (buffer-substring beg end))
		       args))
      (goto-char next)
      (skip-chars-forward " "))
    (if (eolp) (forward-char 1))
    (setq texinfo-command-end (point))
    (nreverse args)))

(defun texinfo-format-parse-args ()
  (let ((start (1- (point)))
	next beg end
	args)
    (search-forward "{")
    (while (/= (preceding-char) ?\})
      (skip-chars-forward " \t\n")
      (setq beg (point))
      (re-search-forward "[},]")
      (setq next (point))
      (forward-char -1)
      (skip-chars-backward " \t\n")
      (setq end (point))
      (cond ((< beg end)
	     (goto-char beg)
	     (while (search-forward "\n" end t)
	       (replace-match " "))))
      (setq args (cons (if (> end beg) (buffer-substring beg end))
		       args))
      (goto-char next))
    (if (eolp) (forward-char 1))
    (setq texinfo-command-end (point))
    (nreverse args)))

(defun texinfo-format-parse-defun-args ()
  (goto-char texinfo-command-end)
  (let ((start (point)))
    (end-of-line)
    (setq texinfo-command-end (1+ (point)))
    (let ((marker (move-marker (make-marker) texinfo-command-end)))
      (texinfo-format-expand-region start (point))
      (setq texinfo-command-end (marker-position marker))
      (move-marker marker nil))
    (goto-char start)
    (let ((args '())
	  beg end)
      (skip-chars-forward " ")
      (while (not (eolp))
	(cond ((looking-at "{")
	       (setq beg (1+ (point)))
	       (forward-list 1)
	       (setq end (1- (point))))
	      (t
	       (setq beg (point))
	       (re-search-forward "[\n ]")
	       (forward-char -1)
	       (setq end (point))))
	(setq args (cons (buffer-substring beg end) args))
	(skip-chars-forward " "))
      (forward-char 1)
      (nreverse args))))

(put 'setfilename 'texinfo-format 'texinfo-format-setfilename)
(defun texinfo-format-setfilename ()
  (let ((arg (texinfo-parse-arg-discard)))
    (setq texinfo-format-filename
	  (file-name-nondirectory (expand-file-name arg)))
    (insert "Info file: "
	    texinfo-format-filename ",    -*-Text-*-\n"
	    "produced by texinfo-format-buffer\nfrom "
	    (if (buffer-file-name input-buffer)
		(concat "file: "
			(file-name-sans-versions
			 (file-name-nondirectory
			  (buffer-file-name input-buffer))))
	      (concat "buffer " (buffer-name input-buffer)))
	    "\n\n")))

(put 'node 'texinfo-format 'texinfo-format-node)
(defun texinfo-format-node ()