code.delx.au - gnu-emacs/blob - lisp/textmodes/po.el

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