texinfmt.el

早期freebsd实现

  (texinfo-parse-arg-discard)
  (insert "-"))

(put 'dots 'texinfo-format 'texinfo-format-dots)
(defun texinfo-format-dots ()
  (texinfo-parse-arg-discard)
  (insert "..."))

(put 'refill 'texinfo-format 'texinfo-format-refill)
(defun texinfo-format-refill ()
  (texinfo-discard-command)
  (fill-paragraph nil))

;; Index generation

(put 'vindex 'texinfo-format 'texinfo-format-vindex)
(defun texinfo-format-vindex ()
  (texinfo-index 'texinfo-vindex))

(put 'cindex 'texinfo-format 'texinfo-format-cindex)
(defun texinfo-format-cindex ()
  (texinfo-index 'texinfo-cindex))

(put 'findex 'texinfo-format 'texinfo-format-findex)
(defun texinfo-format-findex ()
  (texinfo-index 'texinfo-findex))

(put 'pindex 'texinfo-format 'texinfo-format-pindex)
(defun texinfo-format-pindex ()
  (texinfo-index 'texinfo-pindex))

(put 'tindex 'texinfo-format 'texinfo-format-tindex)
(defun texinfo-format-tindex ()
  (texinfo-index 'texinfo-tindex))

(put 'kindex 'texinfo-format 'texinfo-format-kindex)
(defun texinfo-format-kindex ()
  (texinfo-index 'texinfo-kindex))

(defun texinfo-index (indexvar)
  (let ((arg (texinfo-parse-expanded-arg)))
    (texinfo-discard-command)
    (set indexvar
	 (cons (list arg texinfo-last-node)
	       (symbol-value indexvar)))))

(defconst texinfo-indexvar-alist
  '(("cp" . texinfo-cindex)
    ("fn" . texinfo-findex)
    ("vr" . texinfo-vindex)
    ("tp" . texinfo-tindex)
    ("pg" . texinfo-pindex)
    ("ky" . texinfo-kindex)))

(put 'printindex 'texinfo-format 'texinfo-format-printindex)
(defun texinfo-format-printindex ()
  (let ((indexelts (symbol-value
		    (cdr (assoc (texinfo-parse-arg-discard)
				texinfo-indexvar-alist))))
	opoint)
    (insert "\n* Menu:\n\n")
    (setq opoint (point))
    (texinfo-print-index nil indexelts)
    (if (eq system-type 'vax-vms) 
	(texinfo-sort-region opoint (point))
      (shell-command-on-region opoint (point) "sort -fd" 1))))

(defun texinfo-print-index (file indexelts)
  (while indexelts
    (if (stringp (car (car indexelts)))
	(insert "* " (car (car indexelts))
		": " (if file (concat "(" file ")") "")
		(nth 1 (car indexelts)) ".\n")
      ;; index entries from @include'd file
      (texinfo-print-index (nth 1 (car indexelts))
			   (nth 2 (car indexelts))))
    (setq indexelts (cdr indexelts))))


;;;; Lisp Definitions

(defun texinfo-format-defun ()
  (texinfo-push-stack 'defun nil)
  (setq fill-column (- fill-column 5))
  (texinfo-format-defun-1 t))

(defun texinfo-format-defunx ()
  (texinfo-format-defun-1 nil))

(defun texinfo-format-defun-1 (first-p)
  (let ((args (texinfo-format-parse-defun-args))
	(type (get texinfo-command-name 'texinfo-defun-type)))
    (texinfo-discard-command)
    (if (eq type 'arg)
	(progn (setq type (car args))
	       (setq args (cdr args))))
    (let ((formatter (get texinfo-command-name 'texinfo-defun-format-type)))
      (if formatter
	  (setq type (funcall formatter type args))))
    ;; Delete extra newline inserted after previous header line.
    (if (not first-p)
	(delete-char -1))
    (insert "* " type ": " (car args))
    (let ((args (cdr args)))
      (while args
	(insert " "
		(if (= ?& (aref (car args) 0))
		    (car args)
		  (upcase (car args))))
	(setq args (cdr args))))
    ;; Insert extra newline so that paragraph filling does not mess
    ;; with header line.
    (insert "\n\n")
    (rplaca (cdr (cdr (car texinfo-stack))) (point))
    (let ((indexvar (get texinfo-command-name 'texinfo-defun-index))
	  (formatter (get texinfo-command-name 'texinfo-defun-format-index)))
      (set indexvar
	   (cons (list (if formatter (funcall formatter type args) (car args))
		       texinfo-last-node)
		 (symbol-value indexvar))))))

(defun texinfo-end-defun ()
  (setq fill-column (+ fill-column 5))
  (texinfo-discard-command)
  (let ((start (nth 1 (texinfo-pop-stack 'defun))))
    (texinfo-do-itemize start)
    ;; Delete extra newline inserted after header.
    (save-excursion
      (goto-char start)
      (delete-char -1))))

(put 'deffn 'texinfo-format 'texinfo-format-defun)
(put 'deffnx 'texinfo-format 'texinfo-format-defunx)
(put 'deffn 'texinfo-end 'texinfo-end-defun)
(put 'deffn 'texinfo-defun-type 'arg)
(put 'deffnx 'texinfo-defun-type 'arg)
(put 'deffn 'texinfo-defun-index 'texinfo-findex)
(put 'deffnx 'texinfo-defun-index 'texinfo-findex)

(put 'defun 'texinfo-format 'texinfo-format-defun)
(put 'defunx 'texinfo-format 'texinfo-format-defunx)
(put 'defun 'texinfo-end 'texinfo-end-defun)
(put 'defun 'texinfo-defun-type "Function")
(put 'defunx 'texinfo-defun-type "Function")
(put 'defun 'texinfo-defun-index 'texinfo-findex)
(put 'defunx 'texinfo-defun-index 'texinfo-findex)

(put 'defmac 'texinfo-format 'texinfo-format-defun)
(put 'defmacx 'texinfo-format 'texinfo-format-defunx)
(put 'defmac 'texinfo-end 'texinfo-end-defun)
(put 'defmac 'texinfo-defun-type "Macro")
(put 'defmacx 'texinfo-defun-type "Macro")
(put 'defmac 'texinfo-defun-index 'texinfo-findex)
(put 'defmacx 'texinfo-defun-index 'texinfo-findex)

(put 'defspec 'texinfo-format 'texinfo-format-defun)
(put 'defspecx 'texinfo-format 'texinfo-format-defunx)
(put 'defspec 'texinfo-end 'texinfo-end-defun)
(put 'defspec 'texinfo-defun-type "Special form")
(put 'defspecx 'texinfo-defun-type "Special form")
(put 'defspec 'texinfo-defun-index 'texinfo-findex)
(put 'defspecx 'texinfo-defun-index 'texinfo-findex)

(put 'defvr 'texinfo-format 'texinfo-format-defun)
(put 'defvrx 'texinfo-format 'texinfo-format-defunx)
(put 'defvr 'texinfo-end 'texinfo-end-defun)
(put 'defvr 'texinfo-defun-type 'arg)
(put 'defvrx 'texinfo-defun-type 'arg)
(put 'defvr 'texinfo-defun-index 'texinfo-vindex)
(put 'defvrx 'texinfo-defun-index 'texinfo-vindex)

(put 'defvar 'texinfo-format 'texinfo-format-defun)
(put 'defvarx 'texinfo-format 'texinfo-format-defunx)
(put 'defvar 'texinfo-end 'texinfo-end-defun)
(put 'defvar 'texinfo-defun-type "Variable")
(put 'defvarx 'texinfo-defun-type "Variable")
(put 'defvar 'texinfo-defun-index 'texinfo-vindex)
(put 'defvarx 'texinfo-defun-index 'texinfo-vindex)

(put 'defopt 'texinfo-format 'texinfo-format-defun)
(put 'defoptx 'texinfo-format 'texinfo-format-defunx)
(put 'defopt 'texinfo-end 'texinfo-end-defun)
(put 'defopt 'texinfo-defun-type "User Option")
(put 'defoptx 'texinfo-defun-type "User Option")
(put 'defopt 'texinfo-defun-index 'texinfo-vindex)
(put 'defoptx 'texinfo-defun-index 'texinfo-vindex)

(put 'deftp 'texinfo-format 'texinfo-format-defun)
(put 'deftpx 'texinfo-format 'texinfo-format-defunx)
(put 'deftp 'texinfo-end 'texinfo-end-defun)
(put 'deftp 'texinfo-defun-type 'arg)
(put 'deftpx 'texinfo-defun-type 'arg)
(put 'deftp 'texinfo-defun-index 'texinfo-tindex)
(put 'deftpx 'texinfo-defun-index 'texinfo-tindex)

;;; Object-oriented stuff is a little hairier.

(put 'defop 'texinfo-format 'texinfo-format-defun)
(put 'defopx 'texinfo-format 'texinfo-format-defunx)
(put 'defop 'texinfo-end 'texinfo-end-defun)
(put 'defop 'texinfo-defun-type 'arg)
(put 'defopx 'texinfo-defun-type 'arg)
(put 'defop 'texinfo-defun-format-type 'texinfo-format-defop-type)
(put 'defopx 'texinfo-defun-format-type 'texinfo-format-defop-type)
(put 'defop 'texinfo-defun-index 'texinfo-findex)
(put 'defopx 'texinfo-defun-index 'texinfo-findex)
(put 'defop 'texinfo-defun-format-index 'texinfo-format-defop-index)
(put 'defopx 'texinfo-defun-format-index 'texinfo-format-defop-index)

(put 'defmethod 'texinfo-format 'texinfo-format-defun)
(put 'defmethodx 'texinfo-format 'texinfo-format-defunx)
(put 'defmethod 'texinfo-end 'texinfo-end-defun)
(put 'defmethod 'texinfo-defun-type "Operation")
(put 'defmethodx 'texinfo-defun-type "Operation")
(put 'defmethod 'texinfo-defun-format-type 'texinfo-format-defop-type)
(put 'defmethodx 'texinfo-defun-format-type 'texinfo-format-defop-type)
(put 'defmethod 'texinfo-defun-index 'texinfo-findex)
(put 'defmethodx 'texinfo-defun-index 'texinfo-findex)
(put 'defmethod 'texinfo-defun-format-index 'texinfo-format-defop-index)
(put 'defmethodx 'texinfo-defun-format-index 'texinfo-format-defop-index)

(defun texinfo-format-defop-type (type args)
  (format "%s on %s" type (car args)))

(defun texinfo-format-defop-index (type args)
  (format "%s on %s" (car (cdr args)) (car args)))

(put 'defcv 'texinfo-format 'texinfo-format-defun)
(put 'defcvx 'texinfo-format 'texinfo-format-defunx)
(put 'defcv 'texinfo-end 'texinfo-end-defun)
(put 'defcv 'texinfo-defun-type 'arg)
(put 'defcvx 'texinfo-defun-type 'arg)
(put 'defcv 'texinfo-defun-format-type 'texinfo-format-defcv-type)
(put 'defcvx 'texinfo-defun-format-type 'texinfo-format-defcv-type)
(put 'defcv 'texinfo-defun-index 'texinfo-vindex)
(put 'defcvx 'texinfo-defun-index 'texinfo-vindex)
(put 'defcv 'texinfo-defun-format-index 'texinfo-format-defcv-index)
(put 'defcvx 'texinfo-defun-format-index 'texinfo-format-defcv-index)

(put 'defivar 'texinfo-format 'texinfo-format-defun)
(put 'defivarx 'texinfo-format 'texinfo-format-defunx)
(put 'defivar 'texinfo-end 'texinfo-end-defun)
(put 'defivar 'texinfo-defun-type "Instance variable")
(put 'defivarx 'texinfo-defun-type "Instance variable")
(put 'defivar 'texinfo-defun-format-type 'texinfo-format-defcv-type)
(put 'defivarx 'texinfo-defun-format-type 'texinfo-format-defcv-type)
(put 'defivar 'texinfo-defun-index 'texinfo-vindex)
(put 'defivarx 'texinfo-defun-index 'texinfo-vindex)
(put 'defivar 'texinfo-defun-format-index 'texinfo-format-defcv-index)
(put 'defivarx 'texinfo-defun-format-index 'texinfo-format-defcv-index)

(defun texinfo-format-defcv-type (type args)
  (format "%s of %s" type (car args)))

(defun texinfo-format-defcv-index (type args)
  (format "%s of %s" (car (cdr args)) (car args)))

;; process included files
(put 'include 'texinfo-format 'texinfo-format-include)
(defun texinfo-format-include ()
  (let ((filename (texinfo-parse-arg-discard))
	(default-directory input-directory)
	subindex)
    (setq subindex
	  (save-excursion
	    (progn (find-file
		    (cond ((file-readable-p (concat filename ".texinfo"))
			   (concat filename ".texinfo"))
			  ((file-readable-p (concat filename ".tex"))
			   (concat filename ".tex"))
			  ((file-readable-p filename)
			   filename)
			  (t (error "@include'd file %s not found"
				    filename))))
		   (texinfo-format-buffer-1))))
    (texinfo-subindex 'texinfo-vindex (car subindex) (nth 1 subindex))
    (texinfo-subindex 'texinfo-findex (car subindex) (nth 2 subindex))
    (texinfo-subindex 'texinfo-cindex (car subindex) (nth 3 subindex))
    (texinfo-subindex 'texinfo-pindex (car subindex) (nth 4 subindex))
    (texinfo-subindex 'texinfo-tindex (car subindex) (nth 5 subindex))
    (texinfo-subindex 'texinfo-kindex (car subindex) (nth 6 subindex))))

(defun texinfo-subindex (indexvar file content)
  (set indexvar (cons (list 'recurse file content)
		      (symbol-value indexvar))))


;; Lots of bolio constructs do nothing in texinfo.

(put 'page 'texinfo-format 'texinfo-discard-line-with-args)
(put 'c 'texinfo-format 'texinfo-discard-line-with-args)
(put 'comment 'texinfo-format 'texinfo-discard-line-with-args)
(put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args)
(put 'contents 'texinfo-format 'texinfo-discard-line-with-args)
(put 'summarycontents 'texinfo-format 'texinfo-discard-line-with-args)
(put 'nopara 'texinfo-format 'texinfo-discard-line-with-args)
(put 'noindent 'texinfo-format 'texinfo-discard-line-with-args)
(put 'setx 'texinfo-format 'texinfo-discard-line-with-args)
(put 'setq 'texinfo-format 'texinfo-discard-line-with-args)
(put 'settitle 'texinfo-format 'texinfo-discard-line-with-args)
(put 'defindex 'texinfo-format 'texinfo-discard-line-with-args)
(put 'synindex 'texinfo-format 'texinfo-discard-line-with-args)
(put 'hsize 'texinfo-format 'texinfo-discard-line-with-args)
(put 'parindent 'texinfo-format 'texinfo-discard-line-with-args)
(put 'lispnarrowing 'texinfo-format 'texinfo-discard-line-with-args)
(put 'itemindent 'texinfo-format 'texinfo-discard-line-with-args)
(put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
(put 'group 'texinfo-format 'texinfo-discard-line-with-args)
(put 'group 'texinfo-end 'texinfo-discard-line-with-args)
(put 'bye 'texinfo-format 'texinfo-discard-line)
(put 'smallbook 'texinfo-format 'texinfo-discard-line)

(defun texinfo-discard-line-with-args ()
  (goto-char texinfo-command-start)
  (delete-region (point) (progn (forward-line 1) (point))))

;; Sort an index which is in the current buffer between START and END.
;; Used on VMS, where the `sort' utility is not available.
(defun texinfo-sort-region (start end)
  (require 'sort)
  (save-restriction
    (narrow-to-region start end)
    (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun)))

;; Subroutine for sorting an index.
;; At start of a line, return a string to sort the line under.
(defun texinfo-sort-startkeyfun ()
  (let ((line
	 (buffer-substring (point) (save-excursion (end-of-line) (point)))))
    ;; Canonicalize whitespace and eliminate funny chars.
    (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line)
      (setq line (concat (substring line 0 (match-beginning 0))
			 " "
			 (substring line (match-end 0) (length line)))))
    line))

;; Some cannot be handled

(defun texinfo-unsupported ()
  (error "%s is not handled by texinfo"
	 (buffer-substring texinfo-command-start texinfo-command-end)))

(defun batch-texinfo-format ()
  "Runs  texinfo-format-buffer  on the files remaining on the command line.
Must be used only with -batch, and kills emacs on completion.
Each file will be processed even if an error occurred previously.
For example, invoke
  \"emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo\"."
  (if (not noninteractive)
      (error "batch-texinfo-format may only be used -batch."))
  (let ((version-control t)
	(auto-save-default nil)
	(find-file-run-dired nil)
	(kept-old-versions 259259)
	(kept-new-versions 259259))
    (let ((error 0)
	  file
	  (files ()))
      (while command-line-args-left
	(setq file (expand-file-name (car command-line-args-left)))
	(cond ((not (file-exists-p file))
	       (message ">> %s does not exist!" file)
	       (setq error 1
		     command-line-args-left (cdr command-line-args-left)))
	      ((file-directory-p file)
	       (setq command-line-args-left
		     (nconc (directory-files file)
			    (cdr command-line-args-left))))
	      (t
	       (setq files (cons file files)
		     command-line-args-left (cdr command-line-args-left)))))
      (while files
	(setq file (car files)
	      files (cdr files))
	(condition-case err
	    (progn
	      (if buffer-file-name (kill-buffer (current-buffer)))
	      (find-file file)
	      (buffer-flush-undo (current-buffer))
	      (set-buffer-modified-p nil)
	      (texinfo-mode)
	      (message "texinfo formatting %s..." file)
	      (texinfo-format-buffer nil)
	      (if (buffer-modified-p)
		  (progn (message "Saving modified %s" (buffer-file-name))
			 (save-buffer))))
	  (error
	   (message ">> Error: %s" (prin1-to-string err))
	   (message ">>  point at")
	   (let ((s (buffer-substring (point)
				      (min (+ (point) 100)
					   (point-max))))
		 (tem 0))
	     (while (setq tem (string-match "\n+" s tem))
	       (setq s (concat (substring s 0 (match-beginning 0))
			       "\n>>  "
			       (substring s (match-end 0)))
		     tem (1+ tem)))
	     (message ">>  %s" s))
	   (setq error 1))))
      (kill-emacs error))))