lisp/textmodes/po.el

   1 ;;; po.el --- basic support of PO translation files -*- coding: latin-1; -*-
   2
   3 ;; Copyright (C) 1995-1998, 2000-2002 Free Software Foundation, Inc.
   4
   5 ;; Authors: François Pinard <pinard@iro.umontreal.ca>,
   6 ;;          Greg McGary <gkm@magilla.cichlid.com>,
   7 ;;          Bruno Haible <bruno@clisp.org>.
   8 ;; Keywords: i18n, files
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This package makes sure visiting PO files decodes them correctly,
  30 ;; according to the Charset= header in the PO file.  For more support
  31 ;; for editing PO files, see po-mode.el.
  32
  33 ;;; Code:
  34
  35 (defconst po-content-type-charset-alist
  36   '(("ASCII" . undecided)
  37     ("ANSI_X3.4-1968" . undecided)
  38     ("US-ASCII" . undecided))
  39   "Alist of coding system versus GNU libc/libiconv canonical charset name.
  40 Contains canonical charset names that don't correspond to coding systems.")
  41
  42 (defun po-find-charset (filename)
  43   "Return PO charset value for FILENAME."
  44   (let ((charset-regexp
  45          "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"")
  46         (short-read nil))
  47     ;; Try the first 4096 bytes.  In case we cannot find the charset value
  48     ;; within the first 4096 bytes (the PO file might start with a long
  49     ;; comment) try the next 4096 bytes repeatedly until we'll know for sure
  50     ;; we've checked the empty header entry entirely.
  51     (while (not (or short-read (re-search-forward "^msgid" nil t)))
  52       (save-excursion
  53         (goto-char (point-max))
  54         (let ((pair (insert-file-contents-literally filename nil
  55                                                     (1- (point))
  56                                                     (1- (+ (point) 4096)))))
  57           (setq short-read (< (nth 1 pair) 4096)))))
  58     (cond ((re-search-forward charset-regexp nil t) (match-string 1))
  59           (short-read nil)
  60           ;; We've found the first msgid; maybe, only a part of the msgstr
  61           ;; value was loaded.  Load the next 1024 bytes; if charset still
  62           ;; isn't available, give up.
  63           (t (save-excursion
  64                (goto-char (point-max))
  65                (insert-file-contents-literally filename nil
  66                                                (1- (point))
  67                                                (1- (+ (point) 1024))))
  68              (if (re-search-forward charset-regexp nil t)
  69                  (match-string 1))))))
  70
  71 (defun po-find-file-coding-system-guts (operation filename)
  72   "Return a (DECODING . ENCODING) pair for OPERATION on PO file FILENAME.
  73 Do so according to FILENAME's declared charset."
  74   (and
  75    (eq operation 'insert-file-contents)
  76    (file-exists-p filename)
  77    (with-temp-buffer
  78      (let* ((coding-system-for-read 'no-conversion)
  79             (charset (or (po-find-charset filename) "ascii"))
  80             assoc)
  81        (list (cond
  82               ((setq assoc
  83                      (assoc-ignore-case charset
  84                                         po-content-type-charset-alist))
  85                (cdr assoc))
  86               ((or (setq assoc (assoc-ignore-case charset coding-system-alist))
  87                    (setq assoc
  88                          (assoc-ignore-case (subst-char-in-string ?_ ?-
  89                                                                   charset)
  90                                             coding-system-alist)))
  91                (intern (car assoc)))
  92               ;; In principle we should also check the `mime-charset'
  93               ;; property of everything in the base coding system
  94               ;; list, but there should always be a coding system
  95               ;; corresponding to the MIME name.
  96               ((featurep 'code-pages)
  97                ;; Give up.
  98                'raw-text)
  99               (t
 100                ;; Try again with code-pages loaded.  Maybe it's best
 101                ;; to require it initially?
 102                (require 'code-pages nil t)
 103                (if (or
 104                     (setq assoc (assoc-ignore-case charset coding-system-alist))
 105                     (setq assoc (assoc-ignore-case (subst-char-in-string
 106                                                     ?_ ?- charset)
 107                                                    coding-system-alist)))
 108                    (intern (car assoc))
 109                  'raw-text))))))))
 110
 111 ;;;###autoload
 112 (defun po-find-file-coding-system (arg-list)
 113   "Return a (DECODING . ENCODING) pair, according to PO file's charset.
 114 Called through `file-coding-system-alist', before the file is visited for real."
 115   (po-find-file-coding-system-guts (car arg-list) (car (cdr arg-list))))
 116 ;; This is for XEmacs.
 117 ;(defun po-find-file-coding-system (operation filename)
 118 ;  "\
 119 ;Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
 120 ;Called through file-coding-system-alist, before the file is visited for real."
 121 ;  (po-find-file-coding-system-guts operation filename))
 122
 123 (provide 'po)
 124
 125 ;;; arch-tag: 56748a57-d64c-4200-8f6b-c3a70496eb8c
 126 ;;; po.el ends here