X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=texi%2Finfohack.el;h=f991593eab2835adb8c4d041d3966ac558536405;hb=a672b0a0b117c6790d1a6bac3dc91463ce5df2f0;hp=89bad3f1b15313d943c18892dea74aee86995b4f;hpb=04ba5250e9e47ebe40860a0902d4ef6405ca143f;p=elisp%2Fgnus.git- diff --git a/texi/infohack.el b/texi/infohack.el index 89bad3f..f991593 100644 --- a/texi/infohack.el +++ b/texi/infohack.el @@ -1,5 +1,5 @@ ;;; infohack.el --- a hack to format info file. -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: info @@ -18,20 +18,69 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: (let ((default-directory (expand-file-name "../lisp/"))) - ;; Adjust `load-path' for APEL. - (load-file "dgnushack.el") + (if (file-exists-p (expand-file-name "dgnuspath.el")) + (load (expand-file-name "dgnuspath.el") nil nil t)) ;; Replace "./" with "../lisp/" in `load-path'. (setq load-path (mapcar 'expand-file-name load-path))) + +(when (featurep 'xemacs) + (condition-case nil + (require 'timer-funcs) + (error " +You should upgrade your XEmacs packages, especially xemacs-base.\n"))) + +;; XEmacs 21.4.17 doesn't provide `line-end-position' which is used +;; when formatting Info files. 2005-02-23 +(condition-case nil + (require 'poe) + (error "\nIn %s, +APEL was not found or an error occurred. You will need to run the +configure script again adding the --with-addpath=APEL_PATH option.\n" + load-path)) + (load-file (expand-file-name "ptexinfmt.el" "./")) +(if (fboundp 'texinfo-copying) + nil + ;; Support @copying and @insertcopying for Emacs 21.3 and lesser and + ;; XEmacs. + (defvar texinfo-copying-text "" + "Text of the copyright notice and copying permissions.") + + (defun texinfo-copying () + "Copy the copyright notice and copying permissions from the Texinfo file, +as indicated by the @copying ... @end copying command; +insert the text with the @insertcopying command." + (let ((beg (progn (beginning-of-line) (point))) + (end (progn (re-search-forward "^@end copying[ \t]*\n") (point)))) + (setq texinfo-copying-text + (buffer-substring-no-properties + (save-excursion (goto-char beg) (forward-line 1) (point)) + (save-excursion (goto-char end) (forward-line -1) (point)))) + (delete-region beg end))) + + (defun texinfo-insertcopying () + "Insert the copyright notice and copying permissions from the Texinfo file, +which are indicated by the @copying ... @end copying command." + (insert (concat "\n" texinfo-copying-text))) + + (defadvice texinfo-format-scan (before expand-@copying-section activate) + "Extract @copying and replace @insertcopying with it." + (goto-char (point-min)) + (when (search-forward "@copying" nil t) + (texinfo-copying)) + (while (search-forward "@insertcopying" nil t) + (delete-region (match-beginning 0) (match-end 0)) + (texinfo-insertcopying)))) + (defun infohack-remove-unsupported () (goto-char (point-min)) (while (re-search-forward "@\\(end \\)?ifnottex" nil t) @@ -45,11 +94,13 @@ (let ((dest-directory default-directory) (max-lisp-eval-depth (max max-lisp-eval-depth 600)) coding-system) + ;; Emacs 21.3 doesn't support @documentencoding + (unless (get 'documentencoding 'texinfo-format) + (put 'documentencoding 'texinfo-format + 'texinfo-discard-line-with-args)) (find-file file) (setq buffer-read-only nil) - (setq coding-system (if (boundp 'buffer-file-coding-system) - buffer-file-coding-system - file-coding-system)) + (setq coding-system buffer-file-coding-system) (infohack-remove-unsupported) (texinfo-every-node-update) (texinfo-format-buffer t) ;; Don't save any file. @@ -57,8 +108,7 @@ (setq buffer-file-name (expand-file-name (file-name-nondirectory buffer-file-name) default-directory)) - (setq buffer-file-coding-system coding-system - file-coding-system coding-system) + (setq buffer-file-coding-system coding-system) (if (> (buffer-size) 100000) (Info-split)) (save-buffer))) @@ -97,16 +147,13 @@ Both characters must have the same length of multi-byte form." (let ((auto-save-default nil) (find-file-run-dired nil) coding-system-for-write - output-coding-system (error 0)) (condition-case err (progn (find-file file) (setq buffer-read-only nil) (buffer-disable-undo (current-buffer)) - (if (boundp 'MULE) - (setq output-coding-system file-coding-system) - (setq coding-system-for-write buffer-file-coding-system)) + (setq coding-system-for-write buffer-file-coding-system) ;; process @include before updating node ;; This might produce some problem if we use @lowersection or ;; such. @@ -160,26 +207,25 @@ Both characters must have the same length of multi-byte form." (texinfo-every-node-update) (set-buffer-modified-p nil) (message "texinfo formatting %s..." file) - (if (featurep 'mule) - ;; Encode messages to terminal. - (let ((si:message (symbol-function 'message))) - (fset 'message - (byte-compile - (if (boundp 'MULE) - `(lambda (fmt &rest args) - (funcall ,si:message "%s" - (code-convert-string - (apply 'format fmt args) - '*internal* '*junet*))) - `(lambda (fmt &rest args) - (funcall ,si:message "%s" - (encode-coding-string - (apply 'format fmt args) - 'iso-2022-7bit)))))) - (unwind-protect - (texinfo-format-buffer nil) - (fset 'message si:message))) - (texinfo-format-buffer nil)) + (let ((si:message (symbol-function 'message))) + ;; Encode messages to terminal. + (fset + 'message + (byte-compile + (if (featurep 'xemacs) + `(lambda (fmt &rest args) + (unless (and (string-equal fmt "%s clean") + (equal (car args) buffer-file-name)) + (funcall ,si:message "%s" + (encode-coding-string (apply 'format fmt args) + 'iso-2022-7bit)))) + `(lambda (fmt &rest args) + (funcall ,si:message "%s" + (encode-coding-string (apply 'format fmt args) + 'iso-2022-7bit)))))) + (unwind-protect + (texinfo-format-buffer nil) + (fset 'message si:message))) (if (buffer-modified-p) (progn (message "Saving modified %s" (buffer-file-name)) (save-buffer))))