d31aa3654e
Thu Feb 20 2003 Jens Petersen <petersen@redhat.com> - 21.2-33 - default browse-url to use htmlview (#84262) - remove info dir file rather than excluding it Sat Feb 08 2003 Jens Petersen <petersen@redhat.com> - 21.2-32 - set X copy'n'paste encoding to extended compound-text (#74100) by default in .emacs file [suggested by olonho@hotmail.com] - .emacs file cleanup (xemacs now has a separate init file) Fri Feb 07 2003 Jens Petersen <petersen@redhat.com> - 21.2-31 - block input in allocate_vectorlike to prevent malloc hangs (#83600) [thanks to Jim Blandy] - set startup wmclass notify in desktop file Wed Jan 22 2003 Tim Powers <timp@redhat.com> - rebuilt Wed Jan 15 2003 Jens Petersen <petersen@redhat.com> 21.2-29 - update to newer po-mode.el and po-compat.el from gettext-0.11.4 - patch po-mode's po-replace-revision-date for when po-auto-replace-revision-date is nil (#71264) - update po-mode-init.el - examine LC_ALL before LC_CTYPE in site-start.el for utf-8 (#79535) - don't install etc/DOC files explicitly by hand - make sure all lisp .elc files are up to date - pass _smp_mflags to make - remove games that we shouldn't ship Mon Jan 13 2003 Karsten Hopp <karsten@redhat.de> 21.2-28 - s390x lib64 fix Fri Jan 03 2003 Jens Petersen <petersen@redhat.com> 21.2-27 - look at LANG after LC_CTYPE when checking for UTF-8 locale encoding in site-start.el (#79535) - don't set desktop file config(noreplace) Fri Dec 20 2002 Jens Petersen <petersen@redhat.com> 21.2-26 - unset the sticky bit of emacs in bindir (#80049) Wed Dec 18 2002 Jens Petersen <petersen@redhat.com> 21.2-25 - no need to patch config.{sub,guess} Tue Dec 03 2002 Tim Waugh <twaugh@redhat.com> - Fix python-mode-init.el (bug #78910). Sun Dec 01 2002 Jens Petersen <petersen@redhat.com> 21.2-24 - rpm-spec-mode update fixes - patch in XEmacs compat functions rather than defining them with apel macros in init file (#78764) - autoload "rpm-spec-mode" not "rpm-spec-mode.el" in same file - let emacs base also own leim dir to avoid startup warning about missing dir when -el and -leim aren't installed (#78764) Thu Nov 28 2002 Jens Petersen <petersen@redhat.com> - use LC_CTYPE rather than LANG to determine default encoding (#78678) [reported by starback@stp.ling.uu.se] Wed Nov 27 2002 Jens Petersen <petersen@redhat.com> 21.2-23 - set transient-mark-mode in dotemacs for Emacs not XEmacs (#75440) - update rpm-spec-mode.el to 0.12 - define needed XEmacs compat functions in new rpm-spec-mode-init.el - tidy site-start.el - move python-mode setup to python-mode - don't build with sbin in path - use _libexecdir, _bindir and _sysconfdir - don't gzip info files explicitly - use tar's C and j options - generate lisp file-lists in single find sweeps over lisp and leim dirs - use -fprint and -fprintf - correct more dir ownerships Sun Nov 24 2002 Florian La Roche <Florian.LaRoche@redhat.de> 21.2-22 - add correct alloca defines for s390 Wed Nov 06 2002 Jens Petersen <petersen@redhat.com> 21.2-21 - uses patches for x86_64 and s390 support and config.{guess,sub} updating Tue Nov 05 2002 Jens Petersen <petersen@redhat.com> 21.2-20 - add support for x86_64 and merge in s390 support from cvs - add alloca defines to amdx86-64.h (from SuSE) Wed Oct 30 2002 Jens Petersen <petersen@redhat.com> 21.2-19 - own our libexec dir (#73984) - only set transient-mark-mode in dotemacs for Emacs (#75440) - update to latest config.{guess,sub} - use _datadir macro
3315 lines
115 KiB
EmacsLisp
3315 lines
115 KiB
EmacsLisp
;;; po-mode.el -- major mode for GNU gettext PO files
|
||
|
||
;; Copyright (C) 1995-1999, 2000-2002 Free Software Foundation, Inc.
|
||
|
||
;; Authors: François Pinard <pinard@iro.umontreal.ca>
|
||
;; Greg McGary <gkm@magilla.cichlid.com>
|
||
;; Keywords: i18n gettext
|
||
;; Created: 1995
|
||
|
||
;; This file is part of GNU gettext.
|
||
|
||
;; GNU gettext 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 2, or (at your option)
|
||
;; any later version.
|
||
|
||
;; GNU gettext 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, 59 Temple Place - Suite 330, Boston,
|
||
;; MA 02111-1307, USA.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This package provides the tools meant to help editing PO files,
|
||
;; as documented in the GNU gettext user's manual. See this manual
|
||
;; for user documentation, which is not repeated here.
|
||
|
||
;; To install, merely put this file somewhere GNU Emacs will find it,
|
||
;; then add the following lines to your .emacs file:
|
||
;;
|
||
;; (autoload 'po-mode "po-mode"
|
||
;; "Major mode for translators to edit PO files" t)
|
||
;; (setq auto-mode-alist (cons '("\\.po\\'\\|\\.po\\." . po-mode)
|
||
;; auto-mode-alist))
|
||
;;
|
||
;; To use the right coding system automatically under Emacs 20 or newer,
|
||
;; also add:
|
||
;;
|
||
;; (autoload 'po-find-file-coding-system "po-compat")
|
||
;; (modify-coding-system-alist 'file "\\.po\\'\\|\\.po\\."
|
||
;; 'po-find-file-coding-system)
|
||
;;
|
||
;; You may also adjust some variables, below, by defining them in your
|
||
;; '.emacs' file, either directly or through command 'M-x customize'.
|
||
|
||
;;; Code:
|
||
|
||
(defconst po-mode-version-string "2.01" "\
|
||
Version number of this version of po-mode.el.")
|
||
|
||
;;; Emacs portability matters - part I.
|
||
;;; Here is the minimum for customization to work. See part II.
|
||
|
||
;; Identify which Emacs variety is being used.
|
||
;; This file supports:
|
||
;; - XEmacs (version 19 and above) -> po-XEMACS = t,
|
||
;; - GNU Emacs (version 20 and above) -> po-EMACS20 = t,
|
||
;; - GNU Emacs (version 19) -> no flag.
|
||
(eval-and-compile
|
||
(cond ((string-match "XEmacs\\|Lucid" emacs-version)
|
||
(setq po-EMACS20 nil po-XEMACS t))
|
||
((and (string-lessp "19" emacs-version) (featurep 'faces))
|
||
(setq po-EMACS20 t po-XEMACS nil))
|
||
(t (setq po-EMACS20 nil po-XEMACS nil))))
|
||
|
||
;; Experiment with Emacs LISP message internationalisation.
|
||
(eval-and-compile
|
||
(or (fboundp 'set-translation-domain)
|
||
(defsubst set-translation-domain (string) nil))
|
||
(or (fboundp 'translate-string)
|
||
(defsubst translate-string (string) string)))
|
||
(defsubst _ (string) (translate-string string))
|
||
(defsubst N_ (string) string)
|
||
|
||
;; Handle missing 'customs' package.
|
||
(eval-and-compile
|
||
(condition-case ()
|
||
(require 'custom)
|
||
(error nil))
|
||
(if (and (featurep 'custom) (fboundp 'custom-declare-variable))
|
||
nil
|
||
(defmacro defgroup (&rest args)
|
||
nil)
|
||
(defmacro defcustom (var value doc &rest args)
|
||
(` (defvar (, var) (, value) (, doc))))))
|
||
|
||
;;; Customisation.
|
||
|
||
(defgroup po nil
|
||
"Major mode for editing PO files"
|
||
:group 'i18n)
|
||
|
||
(defcustom po-auto-edit-with-msgid nil
|
||
"*Automatically use msgid when editing untranslated entries."
|
||
:type 'boolean
|
||
:group 'po)
|
||
|
||
(defcustom po-auto-fuzzy-on-edit nil
|
||
"*Automatically mark entries fuzzy when being edited."
|
||
:type 'boolean
|
||
:group 'po)
|
||
|
||
(defcustom po-auto-select-on-unfuzzy nil
|
||
"*Automatically select some new entry while making an entry not fuzzy."
|
||
:type 'boolean
|
||
:group 'po)
|
||
|
||
(defcustom po-auto-replace-revision-date t
|
||
"*Automatically revise date in headers. Value is nil, t, or ask."
|
||
:type '(choice (const nil)
|
||
(const t)
|
||
(const ask))
|
||
:group 'po)
|
||
|
||
(defcustom po-default-file-header "\
|
||
# SOME DESCRIPTIVE TITLE.
|
||
# Copyright (C) YEAR Free Software Foundation, Inc.
|
||
# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
|
||
#
|
||
#, fuzzy
|
||
msgid \"\"
|
||
msgstr \"\"
|
||
\"Project-Id-Version: PACKAGE VERSION\\n\"
|
||
\"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n\"
|
||
\"Last-Translator: FULL NAME <EMAIL@ADDRESS>\\n\"
|
||
\"Language-Team: LANGUAGE <LL@li.org>\\n\"
|
||
\"MIME-Version: 1.0\\n\"
|
||
\"Content-Type: text/plain; charset=CHARSET\\n\"
|
||
\"Content-Transfer-Encoding: 8bit\\n\"
|
||
"
|
||
"*Default PO file header."
|
||
:type 'string
|
||
:group 'po)
|
||
|
||
(defcustom po-translation-project-address
|
||
"translation@iro.umontreal.ca"
|
||
"*Electronic mail address of the Translation Project.
|
||
Typing \\[po-send-mail] (normally bound to `M') the user will send the PO file
|
||
to this email address."
|
||
:type 'string
|
||
:group 'po)
|
||
|
||
(defcustom po-translation-project-mail-label "TP-Robot"
|
||
"*Subject label when sending the PO file to `po-translation-project-address'.
|
||
Don't change it when you send PO files to \"translation@iro.umontreal.ca\", the
|
||
Translation Project Robot at http://www.iro.umontreal.ca/contrib/po/HTML/. If
|
||
the label is different, your submission will be consiedered as a regular mail
|
||
and not stored at the TP site and also not forwarded to the package maintainer."
|
||
:type 'string
|
||
:group 'po)
|
||
|
||
(defcustom po-highlighting (or po-EMACS20 po-XEMACS)
|
||
"*Highlight text whenever appropriate, when non-nil.
|
||
However, on older Emacses, a yet unexplained highlighting bug causes files
|
||
to get mangled."
|
||
:type 'boolean
|
||
:group 'po)
|
||
|
||
(defcustom po-highlight-face 'highlight
|
||
"*The face used for PO mode highlighting. For Emacses with overlays.
|
||
Possible values are 'highlight', 'modeline', 'secondary-selection',
|
||
'region', and 'underline'.
|
||
This variable can be set by the user to whatever face they desire.
|
||
It's most convenient if the cursor color and highlight color are
|
||
slightly different."
|
||
:type 'face
|
||
:group 'po)
|
||
|
||
(defcustom po-team-name-to-code
|
||
;; All possible languages, a complete ISO 639 list and a little more.
|
||
'(("LANGUAGE" . "LL")
|
||
("(Afan) Oromo" . "om")
|
||
("Abkhazian" . "ab")
|
||
("Afar" . "aa")
|
||
("Afrikaans" . "af")
|
||
("Albanian" . "sq")
|
||
("Amharic" . "am")
|
||
("Arabic" . "ar")
|
||
("Argentinian" . "es_AR")
|
||
("Armenian" . "hy")
|
||
("Assamese" . "as")
|
||
("Avestan" . "ae")
|
||
("Aymara" . "ay")
|
||
("Azerbaijani" . "az")
|
||
("Bashkir" . "ba")
|
||
("Basque" . "eu")
|
||
("Belarusian" . "be")
|
||
("Bengali" . "bn")
|
||
("Bihari" . "bh")
|
||
("Bislama" . "bi")
|
||
("Bosnian" . "bs")
|
||
("Brazilian Portuguese" . "pt_BR")
|
||
("Breton" . "br")
|
||
("Bulgarian" . "bg")
|
||
("Burmese" . "my")
|
||
("Catalan" . "ca")
|
||
("Chamorro" . "ch")
|
||
("Chechen" . "ce")
|
||
("Chinese" . "zh")
|
||
("Chinese (simplified)" . "zh_CN")
|
||
("Chinese (traditional)" . "zh_TW")
|
||
("Church Slavic" . "cu")
|
||
("Chuvash" . "cv")
|
||
("Cornish" . "kw")
|
||
("Corsican" . "co")
|
||
("Croatian" . "hr")
|
||
("Czech" . "cs")
|
||
("Danish" . "da")
|
||
("Dutch" . "nl")
|
||
("Dzongkha" . "dz")
|
||
("English" . "en")
|
||
("Esperanto" . "eo")
|
||
("Estonian" . "et")
|
||
("Faroese" . "fo")
|
||
("Fijian" . "fj")
|
||
("Finnish" . "fi")
|
||
("French" . "fr")
|
||
("Frisian" . "fy")
|
||
("Galician" . "gl")
|
||
("Georgian" . "ka")
|
||
("German" . "de")
|
||
("Greek" . "el")
|
||
("Guarani" . "gn")
|
||
("Gujarati" . "gu")
|
||
("Hausa" . "ha")
|
||
("Hebrew" . "he")
|
||
("Herero" . "hz")
|
||
("Hindi" . "hi")
|
||
("Hiri Motu" . "ho")
|
||
("Hungarian" . "hu")
|
||
("Icelandic" . "is")
|
||
("Ido" . "io")
|
||
("Indonesian" . "id")
|
||
("Interlingua" . "ia")
|
||
("Interlingue" . "ie")
|
||
("Inuktitut" . "iu")
|
||
("Inupiak" . "ik")
|
||
("Irish" . "ga")
|
||
("Italian" . "it")
|
||
("Japanese" . "ja")
|
||
("Javanese" . "jv")
|
||
("Kalaallisut" . "kl")
|
||
("Kannada" . "kn")
|
||
("Kashmiri" . "ks")
|
||
("Kazakh" . "kk")
|
||
("Khmer" . "km")
|
||
("Kikuyu" . "ki")
|
||
("Kinyarwanda" . "rw")
|
||
("Kirghiz" . "ky")
|
||
("Kirundi" . "rn")
|
||
("Komi" . "kv")
|
||
("Konkani" . "kok")
|
||
("Korean" . "ko")
|
||
("Kuanyama" . "kj")
|
||
("Kurdish" . "ku")
|
||
("Laotian" . "lo")
|
||
("Latin" . "la")
|
||
("Latvian" . "lv")
|
||
("Letzeburgesch" . "lb")
|
||
("Lingala" . "ln")
|
||
("Lithuanian" . "lt")
|
||
("Macedonian" . "mk")
|
||
("Malagasy" . "mg")
|
||
("Malay" . "ms")
|
||
("Malayalam" . "ml")
|
||
("Maltese" . "mt")
|
||
("Manipuri" . "mni")
|
||
("Manx" . "gv")
|
||
("Maori" . "mi")
|
||
("Marathi" . "mr")
|
||
("Marshall" . "mh")
|
||
("Moldavian" . "mo")
|
||
("Mongolian" . "mn")
|
||
("Nauru" . "na")
|
||
("Navajo" . "nv")
|
||
("Ndonga" . "ng")
|
||
("Nepali" . "ne")
|
||
("North Ndebele" . "nd")
|
||
("Northern Sami" . "se")
|
||
("Norwegian Bokmal" . "nb")
|
||
("Norwegian Nynorsk" . "nn")
|
||
("Norwegian" . "no")
|
||
("Nyanja" . "ny")
|
||
("Occitan" . "oc")
|
||
("Oriya" . "or")
|
||
("Ossetian" . "os")
|
||
("Pali" . "pi")
|
||
("Pashto" . "ps")
|
||
("Persian" . "fa")
|
||
("Polish" . "pl")
|
||
("Portuguese" . "pt")
|
||
("Punjabi" . "pa")
|
||
("Quechua" . "qu")
|
||
("Rhaeto-Roman" . "rm")
|
||
("Romanian" . "ro")
|
||
("Russian" . "ru")
|
||
("Samoan" . "sm")
|
||
("Sango" . "sg")
|
||
("Sanskrit" . "sa")
|
||
("Sardinian" . "sc")
|
||
("Scots" . "gd")
|
||
("Serbian" . "sr")
|
||
("Sesotho" . "st")
|
||
("Setswana" . "tn")
|
||
("Shona" . "sn")
|
||
("Sindhi" . "sd")
|
||
("Sinhalese" . "si")
|
||
("Siswati" . "ss")
|
||
("Slovak" . "sk")
|
||
("Slovenian" . "sl")
|
||
("Somali" . "so")
|
||
("Sorbian" . "wen")
|
||
("South Ndebele" . "nr")
|
||
("Spanish" . "es")
|
||
("Sundanese" . "su")
|
||
("Swahili" . "sw")
|
||
("Swedish" . "sv")
|
||
("Tagalog" . "tl")
|
||
("Tahitian" . "ty")
|
||
("Tajik" . "tg")
|
||
("Tamil" . "ta")
|
||
("Tatar" . "tt")
|
||
("Telugu" . "te")
|
||
("Thai" . "th")
|
||
("Tibetan" . "bo")
|
||
("Tigrinya" . "ti")
|
||
("Tonga" . "to")
|
||
("Tsonga" . "ts")
|
||
("Turkish" . "tr")
|
||
("Turkmen" . "tk")
|
||
("Twi" . "tw")
|
||
("Uighur" . "ug")
|
||
("Ukrainian" . "uk")
|
||
("Urdu" . "ur")
|
||
("Uzbek" . "uz")
|
||
("Vietnamese" . "vi")
|
||
("Volapuk" . "vo")
|
||
("Walloon" . "wa")
|
||
("Welsh" . "cy")
|
||
("Wolof" . "wo")
|
||
("Xhosa" . "xh")
|
||
("Yiddish" . "yi")
|
||
("Yoruba" . "yo")
|
||
("Zhuang" . "za")
|
||
("Zulu" . "zu")
|
||
)
|
||
"*Association list giving team codes from team names.
|
||
This is used for generating a submission file name for the 'M' command.
|
||
If a string instead of an alist, it is a team code to use unconditionnally."
|
||
:type 'sexp
|
||
:group 'po)
|
||
|
||
(defcustom po-gzip-uuencode-command "gzip -9 | uuencode -m"
|
||
"*The filter to use for preparing a mail invoice of the PO file.
|
||
Normally \"gzip -9 | uuencode -m\", remove the -9 for lesser compression,
|
||
or remove the -m if you are not using the GNU version of 'uuencode'."
|
||
:type 'string
|
||
:group 'po)
|
||
|
||
(defvar po-subedit-mode-syntax-table
|
||
(copy-syntax-table text-mode-syntax-table)
|
||
"Syntax table used while in PO mode.")
|
||
|
||
;;; Emacs portability matters - part II.
|
||
|
||
;;; Many portability matters are addressed in this page. The few remaining
|
||
;;; cases, elsewhere, all involve 'eval-and-compile', 'boundp' or 'fboundp'.
|
||
|
||
;; Protect string comparisons from text properties if possible.
|
||
(eval-and-compile
|
||
(fset 'po-buffer-substring
|
||
(symbol-function (if (fboundp 'buffer-substring-no-properties)
|
||
'buffer-substring-no-properties
|
||
'buffer-substring)))
|
||
|
||
(if (fboundp 'match-string-no-properties)
|
||
(fset 'po-match-string (symbol-function 'match-string-no-properties))
|
||
(defun po-match-string (number)
|
||
"Return string of text matched by last search."
|
||
(po-buffer-substring (match-beginning number) (match-end number)))))
|
||
|
||
;; Handle missing 'with-temp-buffer' function.
|
||
(eval-and-compile
|
||
(if (fboundp 'with-temp-buffer)
|
||
(fset 'po-with-temp-buffer (symbol-function 'with-temp-buffer))
|
||
|
||
(defmacro po-with-temp-buffer (&rest forms)
|
||
"Create a temporary buffer, and evaluate FORMS there like 'progn'."
|
||
(let ((curr-buffer (make-symbol "curr-buffer"))
|
||
(temp-buffer (make-symbol "temp-buffer")))
|
||
`(let ((,curr-buffer (current-buffer))
|
||
(,temp-buffer (get-buffer-create
|
||
(generate-new-buffer-name " *po-temp*"))))
|
||
(unwind-protect
|
||
(progn
|
||
(set-buffer ,temp-buffer)
|
||
,@forms)
|
||
(set-buffer ,curr-buffer)
|
||
(and (buffer-name ,temp-buffer)
|
||
(kill-buffer ,temp-buffer))))))))
|
||
|
||
;; Handle missing 'kill-new' function.
|
||
(eval-and-compile
|
||
(if (fboundp 'kill-new)
|
||
(fset 'po-kill-new (symbol-function 'kill-new))
|
||
|
||
(defun po-kill-new (string)
|
||
"Push STRING onto the kill ring, for Emacs 18 where kill-new is missing."
|
||
(po-with-temp-buffer
|
||
(insert string)
|
||
(kill-region (point-min) (point-max))))))
|
||
|
||
;; Handle missing 'read-event' function.
|
||
(eval-and-compile
|
||
(fset 'po-read-event
|
||
(cond ((fboundp 'read-event)
|
||
;; GNU Emacs.
|
||
'read-event)
|
||
((fboundp 'next-command-event)
|
||
;; XEmacs.
|
||
'next-command-event)
|
||
(t
|
||
;; Older Emacses.
|
||
'read-char))))
|
||
|
||
;; Handle missing 'force-mode-line-update' function.
|
||
(eval-and-compile
|
||
(if (fboundp 'force-mode-line-update)
|
||
(fset 'po-force-mode-line-update
|
||
(symbol-function 'force-mode-line-update))
|
||
|
||
(defun po-force-mode-line-update ()
|
||
"Force the mode-line of the current buffer to be redisplayed."
|
||
(set-buffer-modified-p (buffer-modified-p)))))
|
||
|
||
;; Handle portable highlighting. Code has been adapted (OK... stolen! :-)
|
||
;; from 'ispell.el'.
|
||
(eval-and-compile
|
||
(cond
|
||
(po-EMACS20
|
||
|
||
(defun po-create-overlay ()
|
||
"Create and return a deleted overlay structure.
|
||
The variable 'po-highlight-face' selects the face to use for highlighting."
|
||
(let ((overlay (make-overlay (point) (point))))
|
||
(overlay-put overlay 'face po-highlight-face)
|
||
;; The fun thing is that a deleted overlay retains its face, and is
|
||
;; movable.
|
||
(delete-overlay overlay)
|
||
overlay))
|
||
|
||
(defun po-highlight (overlay start end &optional buffer)
|
||
"Use OVERLAY to highlight the string from START to END.
|
||
If limits are not relative to the current buffer, use optional BUFFER."
|
||
(move-overlay overlay start end (or buffer (current-buffer))))
|
||
|
||
(defun po-rehighlight (overlay)
|
||
"Ensure OVERLAY is highlighted."
|
||
;; There is nothing to do, as GNU Emacs allows multiple highlights.
|
||
nil)
|
||
|
||
(defun po-dehighlight (overlay)
|
||
"Display normally the last string which OVERLAY highlighted.
|
||
The current buffer should be in PO mode, when this function is called."
|
||
(delete-overlay overlay)))
|
||
|
||
(po-XEMACS
|
||
|
||
(defun po-create-overlay ()
|
||
"Create and return a deleted overlay structure."
|
||
;; The same as for GNU Emacs above, except the created extent is
|
||
;; already detached, so there's no need to "delete" it
|
||
;; explicitly.
|
||
(let ((extent (make-extent nil nil)))
|
||
(set-extent-face extent po-highlight-face)
|
||
extent))
|
||
|
||
(defun po-highlight (extent start end &optional buffer)
|
||
"Use EXTENT to highlight the string from START to END.
|
||
If limits are not relative to the current buffer, use optional BUFFER."
|
||
(set-extent-endpoints extent start end (or buffer (current-buffer))))
|
||
|
||
(defun po-rehighlight (extent)
|
||
"Ensure EXTENT is highlighted."
|
||
;; Nothing to do here.
|
||
nil)
|
||
|
||
(defun po-dehighlight (extent)
|
||
"Display normally the last string which EXTENT highlighted."
|
||
(detach-extent extent)))
|
||
|
||
(t
|
||
|
||
(defun po-create-overlay ()
|
||
"Create and return a deleted overlay structure."
|
||
(cons (make-marker) (make-marker)))
|
||
|
||
(defun po-highlight (overlay start end &optional buffer)
|
||
"Use OVERLAY to highlight the string from START to END.
|
||
If limits are not relative to the current buffer, use optional BUFFER.
|
||
No doubt that highlighting, when Emacs does not allow it, is a kludge."
|
||
(save-excursion
|
||
(and buffer (set-buffer buffer))
|
||
(let ((modified (buffer-modified-p))
|
||
(buffer-read-only nil)
|
||
(inhibit-quit t)
|
||
(buffer-undo-list t)
|
||
(text (buffer-substring start end)))
|
||
(goto-char start)
|
||
(delete-region start end)
|
||
(insert-char ? (- end start))
|
||
(sit-for 0)
|
||
(setq inverse-video (not inverse-video))
|
||
(delete-region start end)
|
||
(insert text)
|
||
(sit-for 0)
|
||
(setq inverse-video (not inverse-video))
|
||
(set-buffer-modified-p modified)))
|
||
(set-marker (car overlay) start (or buffer (current-buffer)))
|
||
(set-marker (cdr overlay) end (or buffer (current-buffer))))
|
||
|
||
(defun po-rehighlight (overlay)
|
||
"Ensure OVERLAY is highlighted."
|
||
(let ((buffer (marker-buffer (car overlay)))
|
||
(start (marker-position (car overlay)))
|
||
(end (marker-position (cdr overlay))))
|
||
(and buffer
|
||
(buffer-name buffer)
|
||
(po-highlight overlay start end buffer))))
|
||
|
||
(defun po-dehighlight (overlay)
|
||
"Display normally the last string which OVERLAY highlighted."
|
||
(let ((buffer (marker-buffer (car overlay)))
|
||
(start (marker-position (car overlay)))
|
||
(end (marker-position (cdr overlay))))
|
||
(if buffer
|
||
(save-excursion
|
||
(set-buffer buffer)
|
||
(let ((modified (buffer-modified-p))
|
||
(buffer-read-only nil)
|
||
(inhibit-quit t)
|
||
(buffer-undo-list t))
|
||
(let ((text (buffer-substring start end)))
|
||
(goto-char start)
|
||
(delete-region start end)
|
||
(insert-char ? (- end start))
|
||
(sit-for 0)
|
||
(delete-region start end)
|
||
(insert text)
|
||
(sit-for 0)
|
||
(set-buffer-modified-p modified)))))
|
||
(setcar overlay (make-marker))
|
||
(setcdr overlay (make-marker))))
|
||
|
||
)))
|
||
|
||
;;; Buffer local variables.
|
||
|
||
;; The following block of declarations has the main purpose of avoiding
|
||
;; byte compiler warnings. It also introduces some documentation for
|
||
;; each of these variables, all meant to be local to PO mode buffers.
|
||
|
||
;; Flag telling that MODE-LINE-STRING should be displayed. See 'Window'
|
||
;; page below. Exceptionally, this variable is local to *all* buffers.
|
||
(defvar po-mode-flag)
|
||
|
||
;; PO buffers are kept read-only to prevent random modifications. READ-ONLY
|
||
;; holds the value of the read-only flag before PO mode was entered.
|
||
(defvar po-read-only)
|
||
|
||
;; The current entry extends from START-OF-ENTRY to END-OF-ENTRY, it
|
||
;; includes preceding whitespace and excludes following whitespace. The
|
||
;; start of keyword lines are START-OF-MSGID and START-OF-MSGSTR.
|
||
;; ENTRY-TYPE classifies the entry.
|
||
(defvar po-start-of-entry)
|
||
(defvar po-start-of-msgid)
|
||
(defvar po-start-of-msgstr)
|
||
(defvar po-end-of-entry)
|
||
(defvar po-entry-type)
|
||
|
||
;; A few counters are usefully shown in the Emacs mode line.
|
||
(defvar po-translated-counter)
|
||
(defvar po-fuzzy-counter)
|
||
(defvar po-untranslated-counter)
|
||
(defvar po-obsolete-counter)
|
||
(defvar po-mode-line-string)
|
||
|
||
;; PO mode keeps track of fields being edited, for one given field should
|
||
;; have one editing buffer at most, and for exiting a PO buffer properly
|
||
;; should offer to close all pending edits. Variable EDITED-FIELDS holds an
|
||
;; an list of "slots" of the form: (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO).
|
||
;; To allow simultaneous edition of the comment and the msgstr of an entry,
|
||
;; ENTRY-MARKER points to the msgid line if a comment is being edited, or to
|
||
;; the msgstr line if the msgstr is being edited. EDIT-BUFFER is the
|
||
;; temporary Emacs buffer used to edit the string. OVERLAY-INFO, when not
|
||
;; nil, holds an overlay (or if overlays are not supported, a cons of two
|
||
;; markers) for this msgid string which became highlighted for the edit.
|
||
(defvar po-edited-fields)
|
||
|
||
;; We maintain a set of movable pointers for returning to entries.
|
||
(defvar po-marker-stack)
|
||
|
||
;; SEARCH path contains a list of directories where files may be found,
|
||
;; in a format suitable for read completion. Each directory includes
|
||
;; its trailing slash. PO mode starts with "./" and "../".
|
||
(defvar po-search-path)
|
||
|
||
;; The following variables are meaningful only when REFERENCE-CHECK
|
||
;; is identical to START-OF-ENTRY, else they should be recomputed.
|
||
;; REFERENCE-ALIST contains all known references for the current
|
||
;; entry, each list element is (PROMPT FILE LINE), where PROMPT may
|
||
;; be used for completing read, FILE is a string and LINE is a number.
|
||
;; REFERENCE-CURSOR is a cycling cursor into REFERENCE-ALIST.
|
||
(defvar po-reference-alist)
|
||
(defvar po-reference-cursor)
|
||
(defvar po-reference-check)
|
||
|
||
;; The following variables are for marking translatable strings in program
|
||
;; sources. KEYWORDS is the list of keywords for marking translatable
|
||
;; strings, kept in a format suitable for reading with completion.
|
||
;; STRING-CONTENTS holds the value of the most recent string found in sources,
|
||
;; and when it is not nil, then STRING-BUFFER, STRING-START and STRING-END
|
||
;; describe where it is. MARKING-OVERLAY, if not 'nil', holds the overlay
|
||
;; which highlight the last found string; for older Emacses, it holds the cons
|
||
;; of two markers around the highlighted region.
|
||
(defvar po-keywords)
|
||
(defvar po-string-contents)
|
||
(defvar po-string-buffer)
|
||
(defvar po-string-start)
|
||
(defvar po-string-end)
|
||
(defvar po-marking-overlay)
|
||
|
||
;;; PO mode variables and constants (usually not to customize).
|
||
|
||
;; The textdomain should really be "gettext", only trying it for now.
|
||
;; All this requires more thinking, we cannot just do this like that.
|
||
(set-translation-domain "po-mode")
|
||
|
||
(defun po-mode-version ()
|
||
"Show Emacs PO mode version."
|
||
(interactive)
|
||
(message (_"Emacs PO mode, version %s") po-mode-version-string))
|
||
|
||
(defconst po-help-display-string
|
||
(_"\
|
||
PO Mode Summary Next Previous Miscellaneous
|
||
*: Later, /: Docum n p Any type . Redisplay
|
||
t T Translated /v Version info
|
||
Moving around f F Fuzzy ?, h This help
|
||
< First if any o O Obsolete = Current index
|
||
> Last if any u U Untranslated 0 Other window
|
||
/SPC Auto select V Validate
|
||
Msgstr Comments M Mail officially
|
||
Modifying entries RET # Call editor _ Undo
|
||
TAB Remove fuzzy mark k K Kill to E Edit out full
|
||
DEL Fuzzy or fade out w W Copy to Q Forceful quit
|
||
LFD Init with msgid y Y Yank from q Confirm and quit
|
||
|
||
gettext Keyword Marking Position Stack
|
||
, Find next string Compendiums m Mark and push current
|
||
M-, Mark translatable *c To compendium r Pop and return
|
||
M-. Change mark, mark *M-C Select, save x Exchange current/top
|
||
|
||
Program Sources Auxiliary Files Lexicography
|
||
s Cycle reference a Cycle file *l Lookup translation
|
||
M-s Select reference C-c C-a Select file *M-l Add/edit translation
|
||
S Consider path A Consider PO file *L Consider lexicon
|
||
M-S Ignore path M-A Ignore PO file *M-L Ignore lexicon
|
||
")
|
||
"Help page for PO mode.")
|
||
|
||
(defconst po-mode-menu-layout
|
||
`("PO"
|
||
("Moving around"
|
||
["Auto select" po-auto-select-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to next interesting entry"))]
|
||
"---"
|
||
"Forward"
|
||
["Any next" po-next-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to next entry"))]
|
||
["Next translated" po-next-translated-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to next translated entry"))]
|
||
["Next fuzzy" po-next-fuzzy-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to next fuzzy entry"))]
|
||
["Next obsolete" po-next-obsolete-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to next obsolete entry"))]
|
||
["Next untranslated" po-next-untranslated-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to next untranslated entry"))]
|
||
["Last file entry" po-last-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to last entry"))]
|
||
"---"
|
||
"Backward"
|
||
["Any previous" po-previous-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to previous entry"))]
|
||
["Previous translated" po-previous-translated-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to previous translated entry"))]
|
||
["Previous fuzzy" po-previous-fuzzy-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to previous fuzzy entry"))]
|
||
["Previous obsolete" po-previous-obsolete-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to previous obsolete entry"))]
|
||
["Previous untranslated" po-previous-untranslated-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to previous untranslated entry"))]
|
||
["First file entry" po-first-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to first entry"))]
|
||
"---"
|
||
"Position stack"
|
||
["Mark and push current" po-push-location
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Remember current location"))]
|
||
["Pop and return" po-pop-location
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to last remembered location and forget about it"))]
|
||
["Exchange current/top" po-exchange-location
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Jump to last remembered location and remember current location"))]
|
||
"---"
|
||
["Redisplay" po-current-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Make current entry properly visible"))]
|
||
["Current index" po-statistics
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Statistical info on current translation file"))])
|
||
("Modifying entries"
|
||
["Undo" po-undo
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Revoke last changed entry"))]
|
||
"---"
|
||
"Msgstr"
|
||
["Edit msgstr" po-edit-msgstr
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Edit current translation"))]
|
||
["Ediff and merge msgstr" po-edit-msgstr-and-ediff
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Call `ediff' on current translation for merging"))]
|
||
["Cut msgstr" po-kill-msgstr
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Cut (kill) current translation"))]
|
||
["Copy msgstr" po-kill-ring-save-msgstr
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Copy current translation"))]
|
||
["Paste msgstr" po-yank-msgstr
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Paste (yank) text most recently cut/copied translation"))]
|
||
"---"
|
||
"Comments"
|
||
["Edit comment" po-edit-comment
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Edit current comment"))]
|
||
["Ediff and merge comment" po-edit-comment-and-ediff
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Call `ediff' on current comment for merging"))]
|
||
["Cut comment" po-kill-comment
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Cut (kill) current comment"))]
|
||
["Copy comment" po-kill-ring-save-comment
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Copy current translation"))]
|
||
["Paste comment" po-yank-comment
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Paste (yank) text most recently cut/copied"))]
|
||
"---"
|
||
["Remove fuzzy mark" po-unfuzzy
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Remove \"#, fuzzy\""))]
|
||
["Fuzzy or fade out" po-fade-out-entry
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Set current entry fuzzy, or if already fuzzy delete it"))]
|
||
["Init with msgid" po-msgid-to-msgstr
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "\
|
||
Initialize or replace current translation with the original message"))])
|
||
("Other files"
|
||
["Other window" po-other-window
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Select other window; if necessay split current frame"))]
|
||
"---"
|
||
"Program sources"
|
||
["Cycle reference" po-cycle-source-reference t]
|
||
["Select reference" po-select-source-reference t]
|
||
["Consider path" po-consider-source-path t]
|
||
["Ignore path" po-ignore-source-path t]
|
||
"---"
|
||
"Compendiums"
|
||
["To compendium" po-save-entry nil]
|
||
["Select, save" po-select-and-save-entry nil]
|
||
"---"
|
||
"Auxiliary files"
|
||
["Cycle file" po-cycle-auxiliary t]
|
||
["Select file" po-select-auxiliary t]
|
||
["Consider file" po-consider-as-auxiliary t]
|
||
["Ignore file" po-ignore-as-auxiliary t]
|
||
"---"
|
||
"Lexicography"
|
||
["Lookup translation" po-lookup-lexicons nil]
|
||
["Add/edit translation" po-edit-lexicon-entry nil]
|
||
["Consider lexicon" po-consider-lexicon-file nil]
|
||
["Ignore lexicon" po-ignore-lexicon-file nil])
|
||
"---"
|
||
"Source marking"
|
||
["Find first string" (po-tags-search '(nil)) t]
|
||
["Prefer keyword" (po-select-mark-and-mark '(nil)) t]
|
||
["Find next string" po-tags-search t]
|
||
["Mark preferred" po-mark-translatable t]
|
||
["Mark with keyword" po-select-mark-and-mark t]
|
||
"---"
|
||
["Version info" po-mode-version
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Display version number of PO mode"))]
|
||
["Help page" po-help
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Show the PO mode help screen"))]
|
||
["Validate" po-validate
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Check validity of current translation file using `msgfmt'"))]
|
||
["Mail officially" po-send-mail
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Send current translation file to the Translation Robot by mail"))]
|
||
["Edit out full" po-edit-out-full
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Leave PO mode to edit translation file using fundamental mode"))]
|
||
"---"
|
||
["Forceful quit" po-quit
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Close (kill) current translation file without saving"))]
|
||
["Soft quit" po-confirm-and-quit
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Save current translation file, than close (kill) it"))])
|
||
"Menu layout for PO mode.")
|
||
|
||
(defconst po-subedit-mode-menu-layout
|
||
`("PO-Edit"
|
||
["Ediff and merge translation variants" po-subedit-ediff
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Call `ediff' for merging variants"))]
|
||
["Cycle through auxiliary files" po-subedit-cycle-auxiliary t]
|
||
"---"
|
||
["Abort edit" po-subedit-abort
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Don't change the translation"))]
|
||
["Exit edit" po-subedit-exit
|
||
,@(if (featurep 'xemacs) '(t)
|
||
'(:help "Use this text as the translation and close current edit buffer"))])
|
||
"Menu layout for PO subedit mode.")
|
||
|
||
(defconst po-subedit-message
|
||
(_"Type 'C-c C-c' once done, or 'C-c C-k' to abort edit")
|
||
"Message to post in the minibuffer when an edit buffer is displayed.")
|
||
|
||
(defvar po-auxiliary-list nil
|
||
"List of auxiliary PO files, in completing read format.")
|
||
|
||
(defvar po-auxiliary-cursor nil
|
||
"Cursor into the 'po-auxiliary-list'.")
|
||
|
||
(defvar po-compose-mail-function
|
||
(let ((functions '(compose-mail-other-window
|
||
message-mail-other-window
|
||
compose-mail
|
||
message-mail))
|
||
result)
|
||
(while (and (not result) functions)
|
||
(if (fboundp (car functions))
|
||
(setq result (car functions))
|
||
(setq functions (cdr functions))))
|
||
(cond (result)
|
||
((fboundp 'mail-other-window)
|
||
(function (lambda (to subject)
|
||
(mail-other-window nil to subject))))
|
||
((fboundp 'mail)
|
||
(function (lambda (to subject)
|
||
(mail nil to subject))))
|
||
(t (function (lambda (to subject)
|
||
(error (_"I do not know how to mail to '%s'") to))))))
|
||
"Function to start composing an electronic message.")
|
||
|
||
(defvar po-any-msgid-regexp
|
||
"^\\(#~[ \t]*\\)?msgid.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*"
|
||
"Regexp matching a whole msgid field, whether obsolete or not.")
|
||
|
||
(defvar po-any-msgstr-regexp
|
||
;; "^\\(#~[ \t]*\\)?msgstr.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*"
|
||
"^\\(#~[ \t]*\\)?msgstr\\(\\[[0-9]\\]\\)?.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*"
|
||
"Regexp matching a whole msgstr or msgstr[] field, whether obsolete or not.")
|
||
|
||
(defvar po-msgstr-idx-keyword-regexp
|
||
"^\\(#~[ \t]*\\)?msgstr\\[[0-9]\\]"
|
||
"Regexp matching an indexed msgstr keyword, whether obsolete or not.")
|
||
|
||
(defvar po-msgfmt-program "msgfmt"
|
||
"Path to msgfmt program from GNU gettext package.")
|
||
|
||
;; Font lock based highlighting code.
|
||
(defconst po-font-lock-keywords
|
||
'(
|
||
;; ("^\\(msgid \\|msgstr \\)?\"\\|\"$" . font-lock-keyword-face)
|
||
;; (regexp-opt
|
||
;; '("msgid " "msgid_plural " "msgstr " "msgstr[0] " "msgstr[1] "))
|
||
("\
|
||
^\\(\\(msg\\(id\\(_plural\\)?\\|str\\(\\[[0-9]\\]\\)?\\)?\\) \\)?\"\\|\"$"
|
||
. font-lock-keyword-face)
|
||
("\\\\.\\|%\\*?[-.0-9ul]*[a-zA-Z]" . font-lock-variable-name-face)
|
||
("^# .*\\|^#[:,]?" . font-lock-comment-face)
|
||
("^#:\\(.*\\)" 1 font-lock-reference-face)
|
||
;; The following line does not work, and I wonder why.
|
||
;;("^#,\\(.*\\)" 1 font-function-name-reference-face)
|
||
)
|
||
"Additional expressions to highlight in PO mode.")
|
||
|
||
;; Old activator for 'font lock'. Is it still useful? I don't think so.
|
||
;;(if (boundp 'font-lock-keywords)
|
||
;; (put 'po-mode 'font-lock-keywords 'po-font-lock-keywords))
|
||
|
||
;; 'hilit19' based highlighting code has been disabled, as most probably
|
||
;; nobody really needs it (it also generates ugly byte-compiler warnings).
|
||
;;
|
||
;;(if (fboundp 'hilit-set-mode-patterns)
|
||
;; (hilit-set-mode-patterns 'po-mode
|
||
;; '(("^# .*\\|^#$" nil comment)
|
||
;; ("^#[.,:].*" nil include)
|
||
;; ("^\\(msgid\\|msgstr\\) *\"" nil keyword)
|
||
;; ("^\"\\|\"$" nil keyword))))
|
||
|
||
;;; Mode activation.
|
||
|
||
;; Emacs 21.2 comes with po-find-file-coding-system. We give preference
|
||
;; to the version shipped with Emacs.
|
||
(if (not (fboundp 'po-find-file-coding-system))
|
||
(require 'po-compat))
|
||
|
||
(defvar po-mode-abbrev-table nil
|
||
"Abbrev table used while in PO mode.")
|
||
(define-abbrev-table 'po-mode-abbrev-table ())
|
||
|
||
(defvar po-mode-map
|
||
;; Use (make-keymap) because (make-sparse-keymap) does not work on Demacs.
|
||
(let ((po-mode-map (make-keymap)))
|
||
(suppress-keymap po-mode-map)
|
||
(define-key po-mode-map "\C-i" 'po-unfuzzy)
|
||
(define-key po-mode-map "\C-j" 'po-msgid-to-msgstr)
|
||
(define-key po-mode-map "\C-m" 'po-edit-msgstr)
|
||
(define-key po-mode-map " " 'po-auto-select-entry)
|
||
(define-key po-mode-map "?" 'po-help)
|
||
(define-key po-mode-map "#" 'po-edit-comment)
|
||
(define-key po-mode-map "," 'po-tags-search)
|
||
(define-key po-mode-map "." 'po-current-entry)
|
||
(define-key po-mode-map "<" 'po-first-entry)
|
||
(define-key po-mode-map "=" 'po-statistics)
|
||
(define-key po-mode-map ">" 'po-last-entry)
|
||
(define-key po-mode-map "a" 'po-cycle-auxiliary)
|
||
;;;; (define-key po-mode-map "c" 'po-save-entry)
|
||
(define-key po-mode-map "f" 'po-next-fuzzy-entry)
|
||
(define-key po-mode-map "h" 'po-help)
|
||
(define-key po-mode-map "k" 'po-kill-msgstr)
|
||
;;;; (define-key po-mode-map "l" 'po-lookup-lexicons)
|
||
(define-key po-mode-map "m" 'po-push-location)
|
||
(define-key po-mode-map "n" 'po-next-entry)
|
||
(define-key po-mode-map "o" 'po-next-obsolete-entry)
|
||
(define-key po-mode-map "p" 'po-previous-entry)
|
||
(define-key po-mode-map "q" 'po-confirm-and-quit)
|
||
(define-key po-mode-map "r" 'po-pop-location)
|
||
(define-key po-mode-map "s" 'po-cycle-source-reference)
|
||
(define-key po-mode-map "t" 'po-next-translated-entry)
|
||
(define-key po-mode-map "u" 'po-next-untranslated-entry)
|
||
(define-key po-mode-map "v" 'po-mode-version)
|
||
(define-key po-mode-map "w" 'po-kill-ring-save-msgstr)
|
||
(define-key po-mode-map "x" 'po-exchange-location)
|
||
(define-key po-mode-map "y" 'po-yank-msgstr)
|
||
(define-key po-mode-map "A" 'po-consider-as-auxiliary)
|
||
(define-key po-mode-map "E" 'po-edit-out-full)
|
||
(define-key po-mode-map "F" 'po-previous-fuzzy-entry)
|
||
(define-key po-mode-map "K" 'po-kill-comment)
|
||
;;;; (define-key po-mode-map "L" 'po-consider-lexicon-file)
|
||
(define-key po-mode-map "M" 'po-send-mail)
|
||
(define-key po-mode-map "O" 'po-previous-obsolete-entry)
|
||
(define-key po-mode-map "T" 'po-previous-translated-entry)
|
||
(define-key po-mode-map "U" 'po-previous-untranslated-entry)
|
||
(define-key po-mode-map "Q" 'po-quit)
|
||
(define-key po-mode-map "S" 'po-consider-source-path)
|
||
(define-key po-mode-map "V" 'po-validate)
|
||
(define-key po-mode-map "W" 'po-kill-ring-save-comment)
|
||
(define-key po-mode-map "Y" 'po-yank-comment)
|
||
(define-key po-mode-map "_" 'po-undo)
|
||
(define-key po-mode-map "0" 'po-other-window)
|
||
(define-key po-mode-map "\177" 'po-fade-out-entry)
|
||
(define-key po-mode-map "\C-c\C-a" 'po-select-auxiliary)
|
||
(define-key po-mode-map "\C-c\C-e" 'po-edit-msgstr-and-ediff)
|
||
(define-key po-mode-map [?\C-c?\C-#] 'po-edit-comment-and-ediff)
|
||
(define-key po-mode-map "\C-c\C-C" 'po-edit-comment-and-ediff)
|
||
(define-key po-mode-map "\M-," 'po-mark-translatable)
|
||
(define-key po-mode-map "\M-." 'po-select-mark-and-mark)
|
||
;;;; (define-key po-mode-map "\M-c" 'po-select-and-save-entry)
|
||
;;;; (define-key po-mode-map "\M-l" 'po-edit-lexicon-entry)
|
||
(define-key po-mode-map "\M-s" 'po-select-source-reference)
|
||
(define-key po-mode-map "\M-A" 'po-ignore-as-auxiliary)
|
||
;;;; (define-key po-mode-map "\M-L" 'po-ignore-lexicon-file)
|
||
(define-key po-mode-map "\M-S" 'po-ignore-source-path)
|
||
po-mode-map)
|
||
"Keymap for PO mode.")
|
||
|
||
(defun po-mode ()
|
||
"Major mode for translators when they edit PO files.
|
||
|
||
Special commands:
|
||
\\{po-mode-map}
|
||
Turning on PO mode calls the value of the variable 'po-mode-hook',
|
||
if that value is non-nil. Behaviour may be adjusted through some variables,
|
||
all reachable through 'M-x customize', in group 'Emacs.Editing.I18n.Po'."
|
||
(interactive)
|
||
(kill-all-local-variables)
|
||
(setq major-mode 'po-mode
|
||
mode-name "PO")
|
||
(use-local-map po-mode-map)
|
||
(if (fboundp 'easy-menu-define)
|
||
(progn
|
||
(easy-menu-define po-mode-menu po-mode-map "" po-mode-menu-layout)
|
||
(and po-XEMACS (easy-menu-add po-mode-menu))))
|
||
(set (make-local-variable 'font-lock-defaults) '(po-font-lock-keywords t))
|
||
|
||
(set (make-local-variable 'po-read-only) buffer-read-only)
|
||
(setq buffer-read-only t)
|
||
|
||
(make-local-variable 'po-start-of-entry)
|
||
(make-local-variable 'po-start-of-msgid)
|
||
(make-local-variable 'po-start-of-msgstr)
|
||
(make-local-variable 'po-end-of-entry)
|
||
(make-local-variable 'po-entry-type)
|
||
|
||
(make-local-variable 'po-translated-counter)
|
||
(make-local-variable 'po-fuzzy-counter)
|
||
(make-local-variable 'po-untranslated-counter)
|
||
(make-local-variable 'po-obsolete-counter)
|
||
(make-local-variable 'po-mode-line-string)
|
||
|
||
(setq po-mode-flag t)
|
||
|
||
(po-check-file-header)
|
||
(po-compute-counters nil)
|
||
|
||
(set (make-local-variable 'po-edited-fields) nil)
|
||
(set (make-local-variable 'po-marker-stack) nil)
|
||
(set (make-local-variable 'po-search-path) '(("./") ("../")))
|
||
|
||
(set (make-local-variable 'po-reference-alist) nil)
|
||
(set (make-local-variable 'po-reference-cursor) nil)
|
||
(set (make-local-variable 'po-reference-check) 0)
|
||
|
||
(set (make-local-variable 'po-keywords)
|
||
'(("gettext") ("gettext_noop") ("_") ("N_")))
|
||
(set (make-local-variable 'po-string-contents) nil)
|
||
(set (make-local-variable 'po-string-buffer) nil)
|
||
(set (make-local-variable 'po-string-start) nil)
|
||
(set (make-local-variable 'po-string-end) nil)
|
||
(set (make-local-variable 'po-marking-overlay) (po-create-overlay))
|
||
|
||
(add-hook 'write-contents-hooks 'po-replace-revision-date)
|
||
|
||
(run-hooks 'po-mode-hook)
|
||
(message (_"You may type 'h' or '?' for a short PO mode reminder.")))
|
||
|
||
(defvar po-subedit-mode-map
|
||
;; Use (make-keymap) because (make-sparse-keymap) does not work on Demacs.
|
||
(let ((po-subedit-mode-map (make-keymap)))
|
||
(define-key po-subedit-mode-map "\C-c\C-a" 'po-subedit-cycle-auxiliary)
|
||
(define-key po-subedit-mode-map "\C-c\C-c" 'po-subedit-exit)
|
||
(define-key po-subedit-mode-map "\C-c\C-e" 'po-subedit-ediff)
|
||
(define-key po-subedit-mode-map "\C-c\C-k" 'po-subedit-abort)
|
||
po-subedit-mode-map)
|
||
"Keymap while editing a PO mode entry (or the full PO file).")
|
||
|
||
;;; Window management.
|
||
|
||
(make-variable-buffer-local 'po-mode-flag)
|
||
|
||
(defvar po-mode-line-entry '(po-mode-flag (" " po-mode-line-string))
|
||
"Mode line format entry displaying MODE-LINE-STRING.")
|
||
|
||
;; Insert MODE-LINE-ENTRY in mode line, but on first load only.
|
||
(or (member po-mode-line-entry mode-line-format)
|
||
;; mode-line-format usually contains global-mode-string, but some
|
||
;; people customize this variable. As a last resort, append at the end.
|
||
(let ((prev-entry (or (member 'global-mode-string mode-line-format)
|
||
(member " " mode-line-format)
|
||
(last mode-line-format))))
|
||
(setcdr prev-entry (cons po-mode-line-entry (cdr prev-entry)))))
|
||
|
||
(defun po-update-mode-line-string ()
|
||
"Compute a new statistics string to display in mode line."
|
||
(setq po-mode-line-string
|
||
(concat (format "%dt" po-translated-counter)
|
||
(if (> po-fuzzy-counter 0)
|
||
(format "+%df" po-fuzzy-counter))
|
||
(if (> po-untranslated-counter 0)
|
||
(format "+%du" po-untranslated-counter))
|
||
(if (> po-obsolete-counter 0)
|
||
(format "+%do" po-obsolete-counter))))
|
||
(po-force-mode-line-update))
|
||
|
||
(defun po-type-counter ()
|
||
"Return the symbol name of the counter appropriate for the current entry."
|
||
(cond ((eq po-entry-type 'obsolete) 'po-obsolete-counter)
|
||
((eq po-entry-type 'fuzzy) 'po-fuzzy-counter)
|
||
((eq po-entry-type 'translated) 'po-translated-counter)
|
||
((eq po-entry-type 'untranslated) 'po-untranslated-counter)
|
||
(t (error (_"Unknown entry type")))))
|
||
|
||
(defun po-decrease-type-counter ()
|
||
"Decrease the counter corresponding to the nature of the current entry."
|
||
(let ((counter (po-type-counter)))
|
||
(set counter (1- (eval counter)))))
|
||
|
||
(defun po-increase-type-counter ()
|
||
"Increase the counter corresponding to the nature of the current entry.
|
||
Then, update the mode line counters."
|
||
(let ((counter (po-type-counter)))
|
||
(set counter (1+ (eval counter))))
|
||
(po-update-mode-line-string))
|
||
|
||
;; Avoid byte compiler warnings.
|
||
(defvar po-fuzzy-regexp)
|
||
(defvar po-untranslated-regexp)
|
||
|
||
(defun po-compute-counters (flag)
|
||
"Prepare counters for mode line display. If FLAG, also echo entry position."
|
||
(and flag (po-find-span-of-entry))
|
||
(setq po-translated-counter 0
|
||
po-fuzzy-counter 0
|
||
po-untranslated-counter 0
|
||
po-obsolete-counter 0)
|
||
(let ((position 0) (total 0) current here)
|
||
;; FIXME 'here' looks obsolete / 2001-08-23 03:54:26 CEST -ke-
|
||
(save-excursion
|
||
(po-find-span-of-entry)
|
||
(setq current po-start-of-msgstr)
|
||
(goto-char (point-min))
|
||
;; While counting, skip the header entry, for consistency with msgfmt.
|
||
(po-find-span-of-entry)
|
||
(if (string-equal (po-get-msgid nil) "")
|
||
(goto-char po-end-of-entry))
|
||
(if (re-search-forward "^msgid" (point-max) t)
|
||
(progn
|
||
;; Start counting
|
||
(while (re-search-forward po-any-msgstr-regexp nil t)
|
||
(and (= (% total 20) 0)
|
||
(if flag
|
||
(message (_"Position %d/%d") position total)
|
||
(message (_"Position %d") total)))
|
||
(setq here (point))
|
||
(goto-char (match-beginning 0))
|
||
(setq total (1+ total))
|
||
(and flag (eq (point) current) (setq position total))
|
||
(cond ((eq (following-char) ?#)
|
||
(setq po-obsolete-counter (1+ po-obsolete-counter)))
|
||
((looking-at po-untranslated-regexp)
|
||
(setq po-untranslated-counter (1+ po-untranslated-counter)))
|
||
(t (setq po-translated-counter (1+ po-translated-counter))))
|
||
(goto-char here))
|
||
|
||
;; Make another pass just for the fuzzy entries, kind of kludgey.
|
||
;; FIXME: Counts will be wrong if untranslated entries are fuzzy, yet
|
||
;; this should not normally happen.
|
||
(goto-char (point-min))
|
||
(while (re-search-forward po-fuzzy-regexp nil t)
|
||
(setq po-fuzzy-counter (1+ po-fuzzy-counter)))
|
||
(setq po-translated-counter (- po-translated-counter po-fuzzy-counter)))
|
||
'()))
|
||
|
||
;; Push the results out.
|
||
(if flag
|
||
(message (_"\
|
||
Position %d/%d; %d translated, %d fuzzy, %d untranslated, %d obsolete")
|
||
position total po-translated-counter po-fuzzy-counter
|
||
po-untranslated-counter po-obsolete-counter)
|
||
(message "")))
|
||
(po-update-mode-line-string))
|
||
|
||
(defun po-redisplay ()
|
||
"Redisplay the current entry."
|
||
;; FIXME: Should try to fit the whole entry on the window. If this is not
|
||
;; possible, should try to fit the comment and the msgid. Otherwise,
|
||
;; should try to fit the msgid. Else, the first line of the msgid should
|
||
;; be at the top of the window.
|
||
(goto-char po-start-of-msgid))
|
||
|
||
(defun po-other-window ()
|
||
"Get the cursor into another window, out of PO mode."
|
||
(interactive)
|
||
(if (one-window-p t)
|
||
(progn
|
||
(split-window)
|
||
(switch-to-buffer (other-buffer)))
|
||
(other-window 1)))
|
||
|
||
;;; Processing the PO file header entry.
|
||
|
||
(defun po-check-file-header ()
|
||
"Create a missing PO mode file header, or replace an oldish one."
|
||
(save-excursion
|
||
(let ((buffer-read-only po-read-only)
|
||
insert-flag end-of-header)
|
||
(goto-char (point-min))
|
||
(if (re-search-forward po-any-msgstr-regexp nil t)
|
||
(progn
|
||
;; There is at least one entry.
|
||
(goto-char (match-beginning 0))
|
||
(previous-line 1)
|
||
(setq end-of-header (match-end 0))
|
||
(if (looking-at "msgid \"\"\n")
|
||
;; There is indeed a PO file header.
|
||
(if (re-search-forward "\n\"PO-Revision-Date: "
|
||
end-of-header t)
|
||
nil
|
||
;; This is an oldish header. Replace it all.
|
||
(goto-char end-of-header)
|
||
(while (> (point) (point-min))
|
||
(previous-line 1)
|
||
(insert "#~ ")
|
||
(beginning-of-line))
|
||
(beginning-of-line)
|
||
(setq insert-flag t))
|
||
;; The first entry is not a PO file header, insert one.
|
||
(setq insert-flag t)))
|
||
;; Not a single entry found.
|
||
(setq insert-flag t))
|
||
(goto-char (point-min))
|
||
(if insert-flag
|
||
(progn
|
||
(insert po-default-file-header)
|
||
(if (not (eobp))
|
||
(insert "\n")))))))
|
||
|
||
(defun po-replace-revision-date ()
|
||
"Replace the revision date by current time in the PO file header."
|
||
(if (fboundp 'format-time-string)
|
||
(if (or (eq po-auto-replace-revision-date t)
|
||
(and (eq po-auto-replace-revision-date 'ask)
|
||
(y-or-n-p (_"May I set PO-Revision-Date? "))))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(if (re-search-forward "^\"PO-Revision-Date:.*" nil t)
|
||
(let* ((buffer-read-only po-read-only)
|
||
(time (current-time))
|
||
(seconds (or (car (current-time-zone time)) 0))
|
||
(minutes (/ (abs seconds) 60))
|
||
(zone (format "%c%02d%02d"
|
||
(if (< seconds 0) ?- ?+)
|
||
(/ minutes 60)
|
||
(% minutes 60))))
|
||
(replace-match
|
||
(concat "\"PO-Revision-Date: "
|
||
(format-time-string "%Y-%m-%d %H:%M" time)
|
||
zone "\\n\"")
|
||
t t))))
|
||
(message ""))
|
||
(message (_"PO-Revision-Date should be adjusted..."))))
|
||
|
||
;;; Handling span of entry, entry type and entry attributes.
|
||
|
||
(defun po-find-span-of-entry ()
|
||
"Find the extent of the PO file entry where the cursor is.
|
||
Set variables PO-START-OF-ENTRY, PO-START-OF-MSGID, PO-START-OF-MSGSTR,
|
||
PO-END-OF-ENTRY and PO-ENTRY-TYPE to meaningful values. Decreasing priority
|
||
of type interpretation is: obsolete, fuzzy, untranslated or translated."
|
||
(let ((here (point)))
|
||
(if (re-search-backward po-any-msgstr-regexp nil t)
|
||
(progn
|
||
;; After a backward match, (match-end 0) will not extend
|
||
;; beyond point, in case point was *inside* the regexp. We
|
||
;; need a dependable (match-end 0), so we redo the match in
|
||
;; the forward direction.
|
||
(re-search-forward po-any-msgstr-regexp)
|
||
(if (<= (match-end 0) here)
|
||
(progn
|
||
;; We most probably found the msgstr of the previous
|
||
;; entry. The current entry then starts just after
|
||
;; its end, save this information just in case.
|
||
(setq po-start-of-entry (match-end 0))
|
||
;; However, it is also possible that we are located in
|
||
;; the crumb after the last entry in the file. If
|
||
;; yes, we know the middle and end of last PO entry.
|
||
(setq po-start-of-msgstr (match-beginning 0)
|
||
po-end-of-entry (match-end 0))
|
||
(if (re-search-forward po-any-msgstr-regexp nil t)
|
||
(progn
|
||
;; We definitely were not in the crumb.
|
||
(setq po-start-of-msgstr (match-beginning 0)
|
||
po-end-of-entry (match-end 0)))
|
||
;; We were in the crumb. The start of the last PO
|
||
;; file entry is the end of the previous msgstr if
|
||
;; any, or else, the beginning of the file.
|
||
(goto-char po-start-of-msgstr)
|
||
(setq po-start-of-entry
|
||
(if (re-search-backward po-any-msgstr-regexp nil t)
|
||
(match-end 0)
|
||
(point-min)))))
|
||
;; The cursor was inside msgstr of the current entry.
|
||
(setq po-start-of-msgstr (match-beginning 0)
|
||
po-end-of-entry (match-end 0))
|
||
;; The start of this entry is the end of the previous
|
||
;; msgstr if any, or else, the beginning of the file.
|
||
(goto-char po-start-of-msgstr)
|
||
(setq po-start-of-entry
|
||
(if (re-search-backward po-any-msgstr-regexp nil t)
|
||
(match-end 0)
|
||
(point-min)))))
|
||
;; The cursor was before msgstr in the first entry in the file.
|
||
(setq po-start-of-entry (point-min))
|
||
(goto-char po-start-of-entry)
|
||
;; There is at least the PO file header, so this should match.
|
||
(re-search-forward po-any-msgstr-regexp)
|
||
(setq po-start-of-msgstr (match-beginning 0)
|
||
po-end-of-entry (match-end 0)))
|
||
;; Find start of msgid.
|
||
(goto-char po-start-of-entry)
|
||
(re-search-forward po-any-msgid-regexp)
|
||
(setq po-start-of-msgid (match-beginning 0))
|
||
;; Classify the entry.
|
||
(setq po-entry-type
|
||
(if (eq (following-char) ?#)
|
||
'obsolete
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-forward po-fuzzy-regexp po-start-of-msgid t)
|
||
'fuzzy
|
||
(goto-char po-start-of-msgstr)
|
||
(if (looking-at po-untranslated-regexp)
|
||
'untranslated
|
||
'translated))))
|
||
;; Put the cursor back where it was.
|
||
(goto-char here)))
|
||
|
||
(defun po-add-attribute (name)
|
||
"Add attribute NAME to the current entry, unless it is already there."
|
||
(save-excursion
|
||
(let ((buffer-read-only po-read-only))
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-forward "\n#[,!] .*" po-start-of-msgid t)
|
||
(save-restriction
|
||
(narrow-to-region (match-beginning 0) (match-end 0))
|
||
(goto-char (point-min))
|
||
(if (re-search-forward (concat "\\b" name "\\b") nil t)
|
||
nil
|
||
(goto-char (point-max))
|
||
(insert ", " name)))
|
||
(skip-chars-forward "\n")
|
||
(while (eq (following-char) ?#)
|
||
(next-line 1))
|
||
(insert "#, " name "\n")))))
|
||
|
||
(defun po-delete-attribute (name)
|
||
"Delete attribute NAME from the current entry, if any."
|
||
(save-excursion
|
||
(let ((buffer-read-only po-read-only))
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-forward "\n#[,!] .*" po-start-of-msgid t)
|
||
(save-restriction
|
||
(narrow-to-region (match-beginning 0) (match-end 0))
|
||
(goto-char (point-min))
|
||
(if (re-search-forward
|
||
(concat "\\(\n#[,!] " name "$\\|, " name "$\\| " name ",\\)")
|
||
nil t)
|
||
(replace-match "" t t)))))))
|
||
|
||
;;; Entry positionning.
|
||
|
||
(defun po-say-location-depth ()
|
||
"Tell how many entries in the entry location stack."
|
||
(let ((depth (length po-marker-stack)))
|
||
(cond ((= depth 0) (message (_"Empty location stack")))
|
||
((= depth 1) (message (_"One entry in location stack")))
|
||
(t (message (_"%d entries in location stack") depth)))))
|
||
|
||
(defun po-push-location ()
|
||
"Stack the location of the current entry, for later return."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(save-excursion
|
||
(goto-char po-start-of-msgid)
|
||
(setq po-marker-stack (cons (point-marker) po-marker-stack)))
|
||
(po-say-location-depth))
|
||
|
||
(defun po-pop-location ()
|
||
"Unstack a saved location, and return to the corresponding entry."
|
||
(interactive)
|
||
(if po-marker-stack
|
||
(progn
|
||
(goto-char (car po-marker-stack))
|
||
(setq po-marker-stack (cdr po-marker-stack))
|
||
(po-current-entry)
|
||
(po-say-location-depth))
|
||
(error (_"The entry location stack is empty"))))
|
||
|
||
(defun po-exchange-location ()
|
||
"Exchange the location of the current entry with the top of stack."
|
||
(interactive)
|
||
(if po-marker-stack
|
||
(progn
|
||
(po-find-span-of-entry)
|
||
(goto-char po-start-of-msgid)
|
||
(let ((location (point-marker)))
|
||
(goto-char (car po-marker-stack))
|
||
(setq po-marker-stack (cons location (cdr po-marker-stack))))
|
||
(po-current-entry)
|
||
(po-say-location-depth))
|
||
(error (_"The entry location stack is empty"))))
|
||
|
||
(defun po-current-entry ()
|
||
"Display the current entry."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(po-redisplay))
|
||
|
||
(defun po-first-entry-with-regexp (regexp)
|
||
"Display the first entry in the file which msgstr matches REGEXP."
|
||
(let ((here (point)))
|
||
(goto-char (point-min))
|
||
(if (re-search-forward regexp nil t)
|
||
(progn
|
||
(goto-char (match-beginning 0))
|
||
(po-current-entry))
|
||
(goto-char here)
|
||
(error (_"There is no such entry")))))
|
||
|
||
(defun po-last-entry-with-regexp (regexp)
|
||
"Display the last entry in the file which msgstr matches REGEXP."
|
||
(let ((here (point)))
|
||
(goto-char (point-max))
|
||
(if (re-search-backward regexp nil t)
|
||
(po-current-entry)
|
||
(goto-char here)
|
||
(error (_"There is no such entry")))))
|
||
|
||
(defun po-next-entry-with-regexp (regexp wrap)
|
||
"Display the entry following the current entry which msgstr matches REGEXP.
|
||
If WRAP is not nil, the search may wrap around the buffer."
|
||
(po-find-span-of-entry)
|
||
(let ((here (point)))
|
||
(goto-char po-end-of-entry)
|
||
(if (re-search-forward regexp nil t)
|
||
(progn
|
||
(goto-char (match-beginning 0))
|
||
(po-current-entry))
|
||
(if (and wrap
|
||
(progn
|
||
(goto-char (point-min))
|
||
(re-search-forward regexp po-start-of-entry t)))
|
||
(progn
|
||
(goto-char (match-beginning 0))
|
||
(po-current-entry)
|
||
(message (_"Wrapping around the buffer")))
|
||
(goto-char here)
|
||
(error (_"There is no such entry"))))))
|
||
|
||
(defun po-previous-entry-with-regexp (regexp wrap)
|
||
"Redisplay the entry preceding the current entry which msgstr matches REGEXP.
|
||
If WRAP is not nil, the search may wrap around the buffer."
|
||
(po-find-span-of-entry)
|
||
(let ((here (point)))
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-backward regexp nil t)
|
||
(po-current-entry)
|
||
(if (and wrap
|
||
(progn
|
||
(goto-char (point-max))
|
||
(re-search-backward regexp po-end-of-entry t)))
|
||
(progn
|
||
(po-current-entry)
|
||
(message (_"Wrapping around the buffer")))
|
||
(goto-char here)
|
||
(error (_"There is no such entry"))))))
|
||
|
||
;; Any entries.
|
||
|
||
(defun po-first-entry ()
|
||
"Display the first entry."
|
||
(interactive)
|
||
(po-first-entry-with-regexp po-any-msgstr-regexp))
|
||
|
||
(defun po-last-entry ()
|
||
"Display the last entry."
|
||
(interactive)
|
||
(po-last-entry-with-regexp po-any-msgstr-regexp))
|
||
|
||
(defun po-next-entry ()
|
||
"Display the entry following the current entry."
|
||
(interactive)
|
||
(po-next-entry-with-regexp po-any-msgstr-regexp nil))
|
||
|
||
(defun po-previous-entry ()
|
||
"Display the entry preceding the current entry."
|
||
(interactive)
|
||
(po-previous-entry-with-regexp po-any-msgstr-regexp nil))
|
||
|
||
;; Untranslated entries.
|
||
|
||
(defvar po-after-entry-regexp
|
||
"\\(\\'\\|\\(#[ \t]*\\)?$\\)"
|
||
"Regexp which should be true after a full msgstr string matched.")
|
||
|
||
(defvar po-untranslated-regexp
|
||
(concat "^msgstr[ \t]*\"\"\n" po-after-entry-regexp)
|
||
"Regexp matching a whole msgstr field, but only if active and empty.")
|
||
|
||
(defun po-next-untranslated-entry ()
|
||
"Find the next untranslated entry, wrapping around if necessary."
|
||
(interactive)
|
||
(po-next-entry-with-regexp po-untranslated-regexp t))
|
||
|
||
(defun po-previous-untranslated-entry ()
|
||
"Find the previous untranslated entry, wrapping around if necessary."
|
||
(interactive)
|
||
(po-previous-entry-with-regexp po-untranslated-regexp t))
|
||
|
||
(defun po-msgid-to-msgstr ()
|
||
"Use another window to edit msgstr reinitialized with msgid."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(if (or (eq po-entry-type 'untranslated)
|
||
(eq po-entry-type 'obsolete)
|
||
(y-or-n-p (_"Really loose previous translation? ")))
|
||
(po-set-msgstr (po-get-msgid nil)))
|
||
(message ""))
|
||
|
||
;; Obsolete entries.
|
||
|
||
(defvar po-obsolete-msgstr-regexp
|
||
"^#~[ \t]*msgstr.*\n\\(#~[ \t]*\".*\n\\)*"
|
||
"Regexp matching a whole msgstr field of an obsolete entry.")
|
||
|
||
(defun po-next-obsolete-entry ()
|
||
"Find the next obsolete entry, wrapping around if necessary."
|
||
(interactive)
|
||
(po-next-entry-with-regexp po-obsolete-msgstr-regexp t))
|
||
|
||
(defun po-previous-obsolete-entry ()
|
||
"Find the previous obsolete entry, wrapping around if necessary."
|
||
(interactive)
|
||
(po-previous-entry-with-regexp po-obsolete-msgstr-regexp t))
|
||
|
||
;; Fuzzy entries.
|
||
|
||
(defvar po-fuzzy-regexp "^#[,!] .*fuzzy"
|
||
"Regexp matching the string inserted by msgmerge for translations
|
||
which does not match exactly.")
|
||
|
||
(defun po-next-fuzzy-entry ()
|
||
"Find the next fuzzy entry, wrapping around if necessary."
|
||
(interactive)
|
||
(po-next-entry-with-regexp po-fuzzy-regexp t))
|
||
|
||
(defun po-previous-fuzzy-entry ()
|
||
"Find the next fuzzy entry, wrapping around if necessary."
|
||
(interactive)
|
||
(po-previous-entry-with-regexp po-fuzzy-regexp t))
|
||
|
||
(defun po-unfuzzy ()
|
||
"Remove the fuzzy attribute for the current entry."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(cond ((eq po-entry-type 'fuzzy)
|
||
(po-decrease-type-counter)
|
||
(po-delete-attribute "fuzzy")
|
||
(po-current-entry)
|
||
(po-increase-type-counter)))
|
||
(if po-auto-select-on-unfuzzy
|
||
(po-auto-select-entry))
|
||
(po-update-mode-line-string))
|
||
|
||
;; Translated entries.
|
||
|
||
(defun po-next-translated-entry ()
|
||
"Find the next translated entry, wrapping around if necessary."
|
||
(interactive)
|
||
(if (= po-translated-counter 0)
|
||
(error (_"There is no such entry"))
|
||
(po-next-entry-with-regexp po-any-msgstr-regexp t)
|
||
(po-find-span-of-entry)
|
||
(while (not (eq po-entry-type 'translated))
|
||
(po-next-entry-with-regexp po-any-msgstr-regexp t)
|
||
(po-find-span-of-entry))))
|
||
|
||
(defun po-previous-translated-entry ()
|
||
"Find the previous translated entry, wrapping around if necessary."
|
||
(interactive)
|
||
(if (= po-translated-counter 0)
|
||
(error (_"There is no such entry"))
|
||
(po-previous-entry-with-regexp po-any-msgstr-regexp t)
|
||
(po-find-span-of-entry)
|
||
(while (not (eq po-entry-type 'translated))
|
||
(po-previous-entry-with-regexp po-untranslated-regexp t)
|
||
(po-find-span-of-entry))))
|
||
|
||
;; Auto-selection feature.
|
||
|
||
(defun po-auto-select-entry ()
|
||
"Select the next entry having the same type as the current one.
|
||
If none, wrap from the beginning of the buffer with another type,
|
||
going from untranslated to fuzzy, and from fuzzy to obsolete.
|
||
Plain translated entries are always disregarded unless there are
|
||
no entries of the other types."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(goto-char po-end-of-entry)
|
||
(if (and (= po-untranslated-counter 0)
|
||
(= po-fuzzy-counter 0)
|
||
(= po-obsolete-counter 0))
|
||
;; All entries are plain translated. Next entry will do, or
|
||
;; wrap around if there is none.
|
||
(if (re-search-forward po-any-msgstr-regexp nil t)
|
||
(goto-char (match-beginning 0))
|
||
(goto-char (point-min)))
|
||
;; If over a translated entry, look for an untranslated one first.
|
||
;; Else, look for an entry of the same type first.
|
||
(let ((goal (if (eq po-entry-type 'translated)
|
||
'untranslated
|
||
po-entry-type)))
|
||
(while goal
|
||
;; Find an untranslated entry, or wrap up for a fuzzy entry.
|
||
(if (eq goal 'untranslated)
|
||
(if (and (> po-untranslated-counter 0)
|
||
(re-search-forward po-untranslated-regexp nil t))
|
||
(progn
|
||
(goto-char (match-beginning 0))
|
||
(setq goal nil))
|
||
(goto-char (point-min))
|
||
(setq goal 'fuzzy)))
|
||
;; Find a fuzzy entry, or wrap up for an obsolete entry.
|
||
(if (eq goal 'fuzzy)
|
||
(if (and (> po-fuzzy-counter 0)
|
||
(re-search-forward po-fuzzy-regexp nil t))
|
||
(progn
|
||
(goto-char (match-beginning 0))
|
||
(setq goal nil))
|
||
(goto-char (point-min))
|
||
(setq goal 'obsolete)))
|
||
;; Find an obsolete entry, or wrap up for an untranslated entry.
|
||
(if (eq goal 'obsolete)
|
||
(if (and (> po-obsolete-counter 0)
|
||
(re-search-forward po-obsolete-msgstr-regexp nil t))
|
||
(progn
|
||
(goto-char (match-beginning 0))
|
||
(setq goal nil))
|
||
(goto-char (point-min))
|
||
(setq goal 'untranslated))))))
|
||
;; Display this entry nicely.
|
||
(po-current-entry))
|
||
|
||
;;; Killing and yanking fields.
|
||
|
||
(defun po-extract-unquoted (buffer start end)
|
||
"Extract and return the unquoted string in BUFFER going from START to END.
|
||
Crumb preceding or following the quoted string is ignored."
|
||
(save-excursion
|
||
(goto-char start)
|
||
(search-forward "\"")
|
||
(setq start (point))
|
||
(goto-char end)
|
||
(search-backward "\"")
|
||
(setq end (point)))
|
||
(po-extract-part-unquoted buffer start end))
|
||
|
||
(defun po-extract-part-unquoted (buffer start end)
|
||
"Extract and return the unquoted string in BUFFER going from START to END.
|
||
Surrounding quotes are already excluded by the position of START and END."
|
||
(po-with-temp-buffer
|
||
(insert-buffer-substring buffer start end)
|
||
;; Glue concatenated strings.
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "\"[ \t]*\\\\?\n\\(#~\\)?[ \t]*\"" nil t)
|
||
(replace-match "" t t))
|
||
;; Remove escaped newlines.
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "\\\\[ \t]*\n" nil t)
|
||
(replace-match "" t t))
|
||
;; Unquote individual characters.
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "\\\\[\"abfnt\\0-7]" nil t)
|
||
(cond ((eq (preceding-char) ?\") (replace-match "\"" t t))
|
||
((eq (preceding-char) ?a) (replace-match "\a" t t))
|
||
((eq (preceding-char) ?b) (replace-match "\b" t t))
|
||
((eq (preceding-char) ?f) (replace-match "\f" t t))
|
||
((eq (preceding-char) ?n) (replace-match "\n" t t))
|
||
((eq (preceding-char) ?t) (replace-match "\t" t t))
|
||
((eq (preceding-char) ?\\) (replace-match "\\" t t))
|
||
(t (let ((value (- (preceding-char) ?0)))
|
||
(replace-match "" t t)
|
||
(while (looking-at "[0-7]")
|
||
(setq value (+ (* 8 value) (- (following-char) ?0)))
|
||
(replace-match "" t t))
|
||
(insert value)))))
|
||
(buffer-string)))
|
||
|
||
(defun po-eval-requoted (form prefix obsolete)
|
||
"Eval FORM, which inserts a string, and return the string fully requoted.
|
||
If PREFIX, precede the result with its contents. If OBSOLETE, comment all
|
||
generated lines in the returned string. Evaluating FORM should insert the
|
||
wanted string in the buffer which is current at the time of evaluation.
|
||
If FORM is itself a string, then this string is used for insertion."
|
||
(po-with-temp-buffer
|
||
(if (stringp form)
|
||
(insert form)
|
||
(push-mark)
|
||
(eval form))
|
||
(goto-char (point-min))
|
||
(let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t)))
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "[\"\a\b\f\n\r\t\\]" nil t)
|
||
(cond ((eq (preceding-char) ?\") (replace-match "\\\"" t t))
|
||
((eq (preceding-char) ?\a) (replace-match "\\a" t t))
|
||
((eq (preceding-char) ?\b) (replace-match "\\b" t t))
|
||
((eq (preceding-char) ?\f) (replace-match "\\f" t t))
|
||
((eq (preceding-char) ?\n)
|
||
(replace-match (if (or (not multi-line) (eobp))
|
||
"\\n"
|
||
"\\n\"\n\"")
|
||
t t))
|
||
((eq (preceding-char) ?\r) (replace-match "\\r" t t))
|
||
((eq (preceding-char) ?\t) (replace-match "\\t" t t))
|
||
((eq (preceding-char) ?\\) (replace-match "\\\\" t t))))
|
||
(goto-char (point-min))
|
||
(if prefix (insert prefix " "))
|
||
(insert (if multi-line "\"\"\n\"" "\""))
|
||
(goto-char (point-max))
|
||
(insert "\"")
|
||
(if prefix (insert "\n"))
|
||
(if obsolete
|
||
(progn
|
||
(goto-char (point-min))
|
||
(while (not (eobp))
|
||
(or (eq (following-char) ?\n) (insert "#~ "))
|
||
(search-forward "\n"))))
|
||
(buffer-string))))
|
||
|
||
(defun po-get-msgid (kill)
|
||
"Extract and return the unquoted msgid string.
|
||
If KILL, then add the unquoted string to the kill ring."
|
||
(let ((string (po-extract-unquoted (current-buffer)
|
||
po-start-of-msgid po-start-of-msgstr)))
|
||
(if kill (po-kill-new string))
|
||
string))
|
||
|
||
(defun po-get-msgstr (kill)
|
||
"Extract and return the unquoted msgstr string.
|
||
If KILL, then add the unquoted string to the kill ring."
|
||
(let ((string (po-extract-unquoted (current-buffer)
|
||
po-start-of-msgstr po-end-of-entry)))
|
||
(if kill (po-kill-new string))
|
||
string))
|
||
|
||
(defun po-set-msgid (form)
|
||
"Replace the current msgid, using FORM to get a string.
|
||
Evaluating FORM should insert the wanted string in the current buffer. If
|
||
FORM is itself a string, then this string is used for insertion. The string
|
||
is properly requoted before the replacement occurs.
|
||
|
||
Returns 'nil' if the buffer has not been modified, for if the new msgid
|
||
described by FORM is merely identical to the msgid already in place."
|
||
(let ((string (po-eval-requoted form "msgid" (eq po-entry-type 'obsolete))))
|
||
(save-excursion
|
||
(goto-char po-start-of-entry)
|
||
(re-search-forward po-any-msgid-regexp po-start-of-msgstr)
|
||
(and (not (string-equal (po-match-string 0) string))
|
||
(let ((buffer-read-only po-read-only))
|
||
(replace-match string t t)
|
||
(goto-char po-start-of-msgid)
|
||
(po-find-span-of-entry)
|
||
t)))))
|
||
|
||
(defun po-set-msgstr (form)
|
||
"Replace the current msgstr or msgstr[], using FORM to get a string.
|
||
Evaluating FORM should insert the wanted string in the current buffer. If
|
||
FORM is itself a string, then this string is used for insertion. The string
|
||
is properly requoted before the replacement occurs.
|
||
|
||
Returns 'nil' if the buffer has not been modified, for if the new msgstr
|
||
described by FORM is merely identical to the msgstr already in place."
|
||
(let ((string (po-eval-requoted form "msgstr" (eq po-entry-type 'obsolete)))
|
||
(msgstr-idx nil))
|
||
(save-excursion
|
||
(goto-char po-start-of-entry)
|
||
(save-excursion ; check for an indexed msgstr
|
||
(if (re-search-forward po-msgstr-idx-keyword-regexp
|
||
po-end-of-entry t)
|
||
(setq msgstr-idx (buffer-substring-no-properties
|
||
(match-beginning 0) (match-end 0)))))
|
||
(re-search-forward po-any-msgstr-regexp po-end-of-entry)
|
||
(and (not (string-equal (po-match-string 0) string))
|
||
(let ((buffer-read-only po-read-only))
|
||
(po-decrease-type-counter)
|
||
(replace-match string t t)
|
||
(goto-char (match-beginning 0))
|
||
(if (eq msgstr-idx nil) ; hack: replace msgstr with msgstr[d]
|
||
nil
|
||
(insert msgstr-idx)
|
||
(looking-at "\\(#~[ \t]*\\)?msgstr")
|
||
(replace-match ""))
|
||
(goto-char po-start-of-msgid)
|
||
(po-find-span-of-entry)
|
||
(po-increase-type-counter)
|
||
t)))))
|
||
|
||
(defun po-kill-ring-save-msgstr ()
|
||
"Push the msgstr string from current entry on the kill ring."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(po-get-msgstr t))
|
||
|
||
(defun po-kill-msgstr ()
|
||
"Empty the msgstr string from current entry, pushing it on the kill ring."
|
||
(interactive)
|
||
(po-kill-ring-save-msgstr)
|
||
(po-set-msgstr ""))
|
||
|
||
(defun po-yank-msgstr ()
|
||
"Replace the current msgstr string by the top of the kill ring."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(po-set-msgstr (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
|
||
(setq this-command 'yank))
|
||
|
||
(defun po-fade-out-entry ()
|
||
"Mark an active entry as fuzzy; obsolete a fuzzy or untranslated entry;
|
||
or completely delete an obsolete entry, saving its msgstr on the kill ring."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
|
||
(cond ((eq po-entry-type 'translated)
|
||
(po-decrease-type-counter)
|
||
(po-add-attribute "fuzzy")
|
||
(po-current-entry)
|
||
(po-increase-type-counter))
|
||
|
||
((or (eq po-entry-type 'fuzzy)
|
||
(eq po-entry-type 'untranslated))
|
||
(if (y-or-n-p (_"Should I really obsolete this entry? "))
|
||
(progn
|
||
(po-decrease-type-counter)
|
||
(save-excursion
|
||
(save-restriction
|
||
(narrow-to-region po-start-of-entry po-end-of-entry)
|
||
(let ((buffer-read-only po-read-only))
|
||
(goto-char (point-min))
|
||
(skip-chars-forward "\n")
|
||
(while (not (eobp))
|
||
(insert "#~ ")
|
||
(search-forward "\n")))))
|
||
(po-current-entry)
|
||
(po-increase-type-counter)))
|
||
(message ""))
|
||
|
||
((and (eq po-entry-type 'obsolete)
|
||
(po-check-for-pending-edit po-start-of-msgid)
|
||
(po-check-for-pending-edit po-start-of-msgstr))
|
||
(po-decrease-type-counter)
|
||
(po-update-mode-line-string)
|
||
(po-get-msgstr t)
|
||
(let ((buffer-read-only po-read-only))
|
||
(delete-region po-start-of-entry po-end-of-entry))
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-forward po-any-msgstr-regexp nil t)
|
||
(goto-char (match-beginning 0))
|
||
(re-search-backward po-any-msgstr-regexp nil t))
|
||
(po-current-entry)
|
||
(message ""))))
|
||
|
||
;;; Killing and yanking comments.
|
||
|
||
(defvar po-active-comment-regexp
|
||
"^\\(#\n\\|# .*\n\\)+"
|
||
"Regexp matching the whole editable comment part of an active entry.")
|
||
|
||
(defvar po-obsolete-comment-regexp
|
||
"^\\(#~ #\n\\|#~ # .*\n\\)+"
|
||
"Regexp matching the whole editable comment part of an obsolete entry.")
|
||
|
||
(defun po-get-comment (kill-flag)
|
||
"Extract and return the editable comment string, uncommented.
|
||
If KILL-FLAG, then add the unquoted comment to the kill ring."
|
||
(let ((buffer (current-buffer))
|
||
(obsolete (eq po-entry-type 'obsolete)))
|
||
(save-excursion
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-forward (if obsolete po-obsolete-comment-regexp
|
||
po-active-comment-regexp)
|
||
po-end-of-entry t)
|
||
(po-with-temp-buffer
|
||
(insert-buffer-substring buffer (match-beginning 0) (match-end 0))
|
||
(goto-char (point-min))
|
||
(while (not (eobp))
|
||
(if (looking-at (if obsolete "#~ # ?" "# ?"))
|
||
(replace-match "" t t))
|
||
(forward-line 1))
|
||
(and kill-flag (copy-region-as-kill (point-min) (point-max)))
|
||
(buffer-string))
|
||
""))))
|
||
|
||
(defun po-set-comment (form)
|
||
"Using FORM to get a string, replace the current editable comment.
|
||
Evaluating FORM should insert the wanted string in the current buffer.
|
||
If FORM is itself a string, then this string is used for insertion.
|
||
The string is properly recommented before the replacement occurs."
|
||
(let ((obsolete (eq po-entry-type 'obsolete))
|
||
string)
|
||
(po-with-temp-buffer
|
||
(if (stringp form)
|
||
(insert form)
|
||
(push-mark)
|
||
(eval form))
|
||
(if (not (or (bobp) (= (preceding-char) ?\n)))
|
||
(insert "\n"))
|
||
(goto-char (point-min))
|
||
(while (not (eobp))
|
||
(insert (if (= (following-char) ?\n)
|
||
(if obsolete "#~ #" "#")
|
||
(if obsolete "#~ # " "# ")))
|
||
(search-forward "\n"))
|
||
(setq string (buffer-string)))
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-forward
|
||
(if obsolete po-obsolete-comment-regexp po-active-comment-regexp)
|
||
po-end-of-entry t)
|
||
(if (not (string-equal (po-match-string 0) string))
|
||
(let ((buffer-read-only po-read-only))
|
||
(replace-match string t t)))
|
||
(skip-chars-forward " \t\n")
|
||
(let ((buffer-read-only po-read-only))
|
||
(insert string))))
|
||
(po-current-entry))
|
||
|
||
(defun po-kill-ring-save-comment ()
|
||
"Push the msgstr string from current entry on the kill ring."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(po-get-comment t))
|
||
|
||
(defun po-kill-comment ()
|
||
"Empty the msgstr string from current entry, pushing it on the kill ring."
|
||
(interactive)
|
||
(po-kill-ring-save-comment)
|
||
(po-set-comment "")
|
||
(po-redisplay))
|
||
|
||
(defun po-yank-comment ()
|
||
"Replace the current comment string by the top of the kill ring."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(po-set-comment (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
|
||
(setq this-command 'yank)
|
||
(po-redisplay))
|
||
|
||
;;; Editing management and submode.
|
||
|
||
;; In a string edit buffer, BACK-POINTER points to one of the slots of the
|
||
;; list EDITED-FIELDS kept in the PO buffer. See its description elsewhere.
|
||
;; Reminder: slots have the form (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO).
|
||
|
||
(defvar po-subedit-back-pointer)
|
||
|
||
(defun po-clean-out-killed-edits ()
|
||
"From EDITED-FIELDS, clean out any edit having a killed edit buffer."
|
||
(let ((cursor po-edited-fields))
|
||
(while cursor
|
||
(let ((slot (car cursor)))
|
||
(setq cursor (cdr cursor))
|
||
(if (buffer-name (nth 1 slot))
|
||
nil
|
||
(let ((overlay (nth 2 slot)))
|
||
(and overlay (po-dehighlight overlay)))
|
||
(setq po-edited-fields (delete slot po-edited-fields)))))))
|
||
|
||
(defun po-check-all-pending-edits ()
|
||
"Resume any pending edit. Return nil if some remains."
|
||
(po-clean-out-killed-edits)
|
||
(or (null po-edited-fields)
|
||
(let ((slot (car po-edited-fields)))
|
||
(goto-char (nth 0 slot))
|
||
(pop-to-buffer (nth 1 slot))
|
||
(let ((overlay (nth 2 slot)))
|
||
(and overlay (po-rehighlight overlay)))
|
||
(message po-subedit-message)
|
||
nil)))
|
||
|
||
(defun po-check-for-pending-edit (position)
|
||
"Resume any pending edit at POSITION. Return nil if such edit exists."
|
||
(po-clean-out-killed-edits)
|
||
(let ((marker (make-marker)))
|
||
(set-marker marker position)
|
||
(let ((slot (assoc marker po-edited-fields)))
|
||
(if slot
|
||
(progn
|
||
(goto-char marker)
|
||
(pop-to-buffer (nth 1 slot))
|
||
(let ((overlay (nth 2 slot)))
|
||
(and overlay (po-rehighlight overlay)))
|
||
(message po-subedit-message)))
|
||
(not slot))))
|
||
|
||
(defun po-edit-out-full ()
|
||
"Get out of PO mode, leaving PO file buffer in fundamental mode."
|
||
(interactive)
|
||
(if (and (po-check-all-pending-edits)
|
||
(yes-or-no-p (_"Should I let you edit the whole PO file? ")))
|
||
(progn
|
||
(setq buffer-read-only po-read-only)
|
||
(fundamental-mode)
|
||
(message (_"Type 'M-x po-mode RET' once done")))))
|
||
|
||
(defun po-ediff-quit ()
|
||
"Quit ediff and exit `recursive-edit'."
|
||
(interactive)
|
||
(ediff-quit t)
|
||
(exit-recursive-edit))
|
||
|
||
(add-hook 'ediff-keymap-setup-hook
|
||
'(lambda ()
|
||
(define-key ediff-mode-map "Q" 'po-ediff-quit)))
|
||
|
||
(defun po-ediff-buffers-exit-recursive (b1 b2 oldbuf end)
|
||
"Ediff buffer B1 and B2, pop back to OLDBUF and replace the old variants.
|
||
This function will delete the first two variants in OLDBUF, call
|
||
`ediff-buffers' to compare both strings and replace the two variants in
|
||
OLDBUF with the contents of B2.
|
||
Once done kill B1 and B2.
|
||
|
||
For more info cf. `po-subedit-ediff'."
|
||
(ediff-buffers b1 b2)
|
||
(recursive-edit)
|
||
(pop-to-buffer oldbuf)
|
||
(delete-region (point-min) end)
|
||
(insert-buffer b2)
|
||
(mapc 'kill-buffer `(,b1 ,b2))
|
||
(display-buffer entry-buffer t))
|
||
|
||
(defun po-subedit-ediff ()
|
||
"Edit the subedit buffer using `ediff'.
|
||
`po-subedit-ediff' calls `po-ediff-buffers-exit-recursive' to edit translation
|
||
variants side by side if they are actually different; if variants are equal just
|
||
delete the first one.
|
||
|
||
`msgcat' is able to produce those variants; every variant is marked with:
|
||
|
||
#-#-#-#-# file name reference #-#-#-#-#
|
||
|
||
Put changes in second buffer.
|
||
|
||
When done with the `ediff' session press \\[exit-recursive-edit] exit to
|
||
`recursive-edit', or call \\[po-ediff-quit] (`Q') in the ediff control panel."
|
||
(interactive)
|
||
(let* ((marker-regex "^#-#-#-#-# \\(.*\\) #-#-#-#-#\n")
|
||
(buf1 " *po-msgstr-1") ; default if first marker is missing
|
||
buf2 start-1 end-1 start-2 end-2
|
||
(back-pointer po-subedit-back-pointer)
|
||
(entry-marker (nth 0 back-pointer))
|
||
(entry-buffer (marker-buffer entry-marker)))
|
||
(goto-char (point-min))
|
||
(if (looking-at marker-regex)
|
||
(and (setq buf1 (match-string-no-properties 1))
|
||
(forward-line 1)))
|
||
(setq start-1 (point))
|
||
(if (not (re-search-forward marker-regex (point-max) t))
|
||
(error "Only 1 msgstr found")
|
||
(setq buf2 (match-string-no-properties 1)
|
||
end-1 (match-beginning 0))
|
||
(let ((oldbuf (current-buffer)))
|
||
(save-current-buffer
|
||
(set-buffer (get-buffer-create
|
||
(generate-new-buffer-name buf1)))
|
||
(setq buffer-read-only nil)
|
||
(erase-buffer)
|
||
(insert-buffer-substring oldbuf start-1 end-1)
|
||
(setq buffer-read-only t))
|
||
|
||
(setq start-2 (point))
|
||
(save-excursion
|
||
;; check for a third variant; if found ignore it
|
||
(if (re-search-forward marker-regex (point-max) t)
|
||
(setq end-2 (match-beginning 0))
|
||
(setq end-2 (goto-char (1- (point-max))))))
|
||
(save-current-buffer
|
||
(set-buffer (get-buffer-create
|
||
(generate-new-buffer-name buf2)))
|
||
(erase-buffer)
|
||
(insert-buffer-substring oldbuf start-2 end-2))
|
||
|
||
(if (not (string-equal (buffer-substring-no-properties start-1 end-1)
|
||
(buffer-substring-no-properties start-2 end-2)))
|
||
(po-ediff-buffers-exit-recursive buf1 buf2 oldbuf end-2)
|
||
(message "Variants are equal; delete %s" buf1)
|
||
(forward-line -1)
|
||
(delete-region (point-min) (point)))))))
|
||
|
||
(defun po-subedit-abort ()
|
||
"Exit the subedit buffer, merely discarding its contents."
|
||
(interactive)
|
||
(let* ((edit-buffer (current-buffer))
|
||
(back-pointer po-subedit-back-pointer)
|
||
(entry-marker (nth 0 back-pointer))
|
||
(overlay-info (nth 2 back-pointer))
|
||
(entry-buffer (marker-buffer entry-marker)))
|
||
(if (null entry-buffer)
|
||
(error (_"Corresponding PO buffer does not exist anymore"))
|
||
(or (one-window-p) (delete-window))
|
||
(switch-to-buffer entry-buffer)
|
||
(goto-char entry-marker)
|
||
(and overlay-info (po-dehighlight overlay-info))
|
||
(kill-buffer edit-buffer)
|
||
(setq po-edited-fields (delete back-pointer po-edited-fields)))))
|
||
|
||
(defun po-subedit-exit ()
|
||
"Exit the subedit buffer, replacing the string in the PO buffer."
|
||
(interactive)
|
||
(goto-char (point-max))
|
||
(skip-chars-backward " \t\n")
|
||
(if (eq (preceding-char) ?<)
|
||
(delete-region (1- (point)) (point-max)))
|
||
(run-hooks 'po-subedit-exit-hook)
|
||
(let ((string (buffer-string)))
|
||
(po-subedit-abort)
|
||
(po-find-span-of-entry)
|
||
(cond ((= (point) po-start-of-msgid)
|
||
(po-set-comment string)
|
||
(po-redisplay))
|
||
((= (point) po-start-of-msgstr)
|
||
(let ((replaced (po-set-msgstr string)))
|
||
(if (and replaced
|
||
po-auto-fuzzy-on-edit
|
||
(eq po-entry-type 'translated))
|
||
(progn
|
||
(po-decrease-type-counter)
|
||
(po-add-attribute "fuzzy")
|
||
(po-current-entry)
|
||
(po-increase-type-counter)))))
|
||
(t (debug)))))
|
||
|
||
(defun po-edit-string (string type expand-tabs)
|
||
"Prepare a pop up buffer for editing STRING, which is of a given TYPE.
|
||
TYPE may be 'comment or 'msgstr. If EXPAND-TABS, expand tabs to spaces.
|
||
Run functions on po-subedit-mode-hook."
|
||
(let ((marker (make-marker)))
|
||
(set-marker marker (cond ((eq type 'comment) po-start-of-msgid)
|
||
((eq type 'msgstr) po-start-of-msgstr)))
|
||
(if (po-check-for-pending-edit marker)
|
||
(let ((edit-buffer (generate-new-buffer
|
||
(concat "*" (buffer-name) "*")))
|
||
(edit-coding buffer-file-coding-system)
|
||
(buffer (current-buffer))
|
||
overlay slot)
|
||
(if (and (eq type 'msgstr) po-highlighting)
|
||
;; ;; Try showing all of msgid in the upper window while editing.
|
||
;; (goto-char (1- po-start-of-msgstr))
|
||
;; (recenter -1)
|
||
(save-excursion
|
||
(goto-char po-start-of-entry)
|
||
(re-search-forward po-any-msgid-regexp nil t)
|
||
(let ((end (1- (match-end 0))))
|
||
(goto-char (match-beginning 0))
|
||
(re-search-forward "msgid +" nil t)
|
||
(setq overlay (po-create-overlay))
|
||
(po-highlight overlay (point) end buffer))))
|
||
(setq slot (list marker edit-buffer overlay)
|
||
po-edited-fields (cons slot po-edited-fields))
|
||
(pop-to-buffer edit-buffer)
|
||
(set (make-local-variable 'po-subedit-back-pointer) slot)
|
||
(set (make-local-variable 'indent-line-function)
|
||
'indent-relative)
|
||
(setq buffer-file-coding-system edit-coding)
|
||
(setq local-abbrev-table po-mode-abbrev-table)
|
||
(erase-buffer)
|
||
(insert string "<")
|
||
(goto-char (point-min))
|
||
(and expand-tabs (setq indent-tabs-mode nil))
|
||
(use-local-map po-subedit-mode-map)
|
||
(if (fboundp 'easy-menu-define)
|
||
(progn
|
||
(easy-menu-define po-subedit-mode-menu po-subedit-mode-map ""
|
||
po-subedit-mode-menu-layout)
|
||
(and po-XEMACS (easy-menu-add po-subedit-mode-menu))))
|
||
(set-syntax-table po-subedit-mode-syntax-table)
|
||
(run-hooks 'po-subedit-mode-hook)
|
||
(message po-subedit-message)))))
|
||
|
||
(defun po-edit-comment ()
|
||
"Use another window to edit the current translator comment."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(po-edit-string (po-get-comment nil) 'comment nil))
|
||
|
||
(defun po-edit-comment-and-ediff ()
|
||
"Use `ediff' to edit the current translator comment.
|
||
This function calls `po-edit-msgstr' and `po-subedit-ediff'; for more info
|
||
read `po-subedit-ediff' documentation."
|
||
(interactive)
|
||
(po-edit-comment)
|
||
(po-subedit-ediff))
|
||
|
||
(defun po-edit-msgstr ()
|
||
"Use another window to edit the current msgstr."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(po-edit-string (if (and po-auto-edit-with-msgid
|
||
(eq po-entry-type 'untranslated))
|
||
(po-get-msgid nil)
|
||
(po-get-msgstr nil))
|
||
'msgstr
|
||
t))
|
||
|
||
(defun po-edit-msgstr-and-ediff ()
|
||
"Use `ediff' to edit the current msgstr.
|
||
This function calls `po-edit-msgstr' and `po-subedit-ediff'; for more info
|
||
read `po-subedit-ediff' documentation."
|
||
(interactive)
|
||
(po-edit-msgstr)
|
||
(po-subedit-ediff))
|
||
|
||
;;; String normalization and searching.
|
||
|
||
(defun po-normalize-old-style (explain)
|
||
"Normalize old gettext style fields using K&R C multiline string syntax.
|
||
To minibuffer messages sent while normalizing, add the EXPLAIN string."
|
||
(let ((here (point-marker))
|
||
(counter 0)
|
||
(buffer-read-only po-read-only))
|
||
(goto-char (point-min))
|
||
(message (_"Normalizing %d, %s") counter explain)
|
||
(while (re-search-forward
|
||
"\\(^#?[ \t]*msg\\(id\\|str\\)[ \t]*\"\\|[^\" \t][ \t]*\\)\\\\\n"
|
||
nil t)
|
||
(if (= (% counter 10) 0)
|
||
(message (_"Normalizing %d, %s") counter explain))
|
||
(replace-match "\\1\"\n\"" t nil)
|
||
(setq counter (1+ counter)))
|
||
(goto-char here)
|
||
(message (_"Normalizing %d...done") counter)))
|
||
|
||
(defun po-normalize-field (field explain)
|
||
"Normalize FIELD of all entries. FIELD is either the symbol msgid or msgstr.
|
||
To minibuffer messages sent while normalizing, add the EXPLAIN string."
|
||
(let ((here (point-marker))
|
||
(counter 0))
|
||
(goto-char (point-min))
|
||
(while (re-search-forward po-any-msgstr-regexp nil t)
|
||
(if (= (% counter 10) 0)
|
||
(message (_"Normalizing %d, %s") counter explain))
|
||
(goto-char (match-beginning 0))
|
||
(po-find-span-of-entry)
|
||
(cond ((eq field 'msgid) (po-set-msgid (po-get-msgid nil)))
|
||
((eq field 'msgstr) (po-set-msgstr (po-get-msgstr nil))))
|
||
(goto-char po-end-of-entry)
|
||
(setq counter (1+ counter)))
|
||
(goto-char here)
|
||
(message (_"Normalizing %d...done") counter)))
|
||
|
||
;; Normalize, but the British way! :-)
|
||
(defsubst po-normalise () (po-normalize))
|
||
|
||
(defun po-normalize ()
|
||
"Normalize all entries in the PO file."
|
||
(interactive)
|
||
(po-normalize-old-style (_"pass 1/3"))
|
||
(po-normalize-field t (_"pass 2/3"))
|
||
(po-normalize-field nil (_"pass 3/3"))
|
||
;; The last PO file entry has just been processed.
|
||
(if (not (= po-end-of-entry (point-max)))
|
||
(let ((buffer-read-only po-read-only))
|
||
(kill-region po-end-of-entry (point-max))))
|
||
;; A bizarre format might have fooled the counters, so recompute
|
||
;; them to make sure their value is dependable.
|
||
(po-compute-counters nil))
|
||
|
||
;;; Multiple PO files.
|
||
|
||
(defun po-show-auxiliary-list ()
|
||
"Echo the current auxiliary list in the message area."
|
||
(if po-auxiliary-list
|
||
(let ((cursor po-auxiliary-cursor)
|
||
string)
|
||
(while cursor
|
||
(setq string (concat string (if string " ") (car (car cursor)))
|
||
cursor (cdr cursor)))
|
||
(setq cursor po-auxiliary-list)
|
||
(while (not (eq cursor po-auxiliary-cursor))
|
||
(setq string (concat string (if string " ") (car (car cursor)))
|
||
cursor (cdr cursor)))
|
||
(message string))
|
||
(message (_"No auxiliary files."))))
|
||
|
||
(defun po-consider-as-auxiliary ()
|
||
"Add the current PO file to the list of auxiliary files."
|
||
(interactive)
|
||
(if (member (list buffer-file-name) po-auxiliary-list)
|
||
nil
|
||
(setq po-auxiliary-list
|
||
(nconc po-auxiliary-list (list (list buffer-file-name))))
|
||
(or po-auxiliary-cursor
|
||
(setq po-auxiliary-cursor po-auxiliary-list)))
|
||
(po-show-auxiliary-list))
|
||
|
||
(defun po-ignore-as-auxiliary ()
|
||
"Delete the current PO file from the list of auxiliary files."
|
||
(interactive)
|
||
(setq po-auxiliary-list (delete (list buffer-file-name) po-auxiliary-list)
|
||
po-auxiliary-cursor po-auxiliary-list)
|
||
(po-show-auxiliary-list))
|
||
|
||
(defun po-seek-equivalent-translation (name string)
|
||
"Search a PO file NAME for a 'msgid' STRING having a non-empty 'msgstr'.
|
||
STRING is the full quoted msgid field, including the 'msgid' keyword. When
|
||
found, display the file over the current window, with the 'msgstr' field
|
||
possibly highlighted, the cursor at start of msgid, then return 't'.
|
||
Otherwise, move nothing, and just return 'nil'."
|
||
(let ((current (current-buffer))
|
||
(buffer (find-file-noselect name)))
|
||
(set-buffer buffer)
|
||
(let ((start (point))
|
||
found)
|
||
(goto-char (point-min))
|
||
(while (and (not found) (search-forward string nil t))
|
||
;; Screen out longer 'msgid's.
|
||
(if (looking-at "^msgstr ")
|
||
(progn
|
||
(po-find-span-of-entry)
|
||
;; Ignore an untranslated entry.
|
||
(or (string-equal
|
||
(buffer-substring po-start-of-msgstr po-end-of-entry)
|
||
"msgstr \"\"\n")
|
||
(setq found t)))))
|
||
(if found
|
||
(progn
|
||
(switch-to-buffer buffer)
|
||
(po-find-span-of-entry)
|
||
(if po-highlighting
|
||
(progn
|
||
(goto-char po-start-of-entry)
|
||
(re-search-forward po-any-msgstr-regexp nil t)
|
||
(let ((end (1- (match-end 0))))
|
||
(goto-char (match-beginning 0))
|
||
(re-search-forward "msgstr +" nil t)
|
||
;; Just "borrow" the marking overlay.
|
||
(po-highlight po-marking-overlay (point) end))))
|
||
(goto-char po-start-of-msgid))
|
||
(goto-char start)
|
||
(po-find-span-of-entry)
|
||
(set-buffer current))
|
||
found)))
|
||
|
||
(defun po-cycle-auxiliary ()
|
||
"Select the next auxiliary file having an entry with same 'msgid'."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(if po-auxiliary-list
|
||
(let ((string (buffer-substring po-start-of-msgid po-start-of-msgstr))
|
||
(cursor po-auxiliary-cursor)
|
||
found name)
|
||
(while (and (not found) cursor)
|
||
(setq name (car (car cursor)))
|
||
(if (and (not (string-equal buffer-file-name name))
|
||
(po-seek-equivalent-translation name string))
|
||
(setq found t
|
||
po-auxiliary-cursor cursor))
|
||
(setq cursor (cdr cursor)))
|
||
(setq cursor po-auxiliary-list)
|
||
(while (and (not found) cursor)
|
||
(setq name (car (car cursor)))
|
||
(if (and (not (string-equal buffer-file-name name))
|
||
(po-seek-equivalent-translation name string))
|
||
(setq found t
|
||
po-auxiliary-cursor cursor))
|
||
(setq cursor (cdr cursor)))
|
||
(or found (message (_"No other translation found")))
|
||
found)))
|
||
|
||
(defun po-subedit-cycle-auxiliary ()
|
||
"Cycle auxiliary file, but from the translation edit buffer."
|
||
(interactive)
|
||
(let* ((entry-marker (nth 0 po-subedit-back-pointer))
|
||
(entry-buffer (marker-buffer entry-marker))
|
||
(buffer (current-buffer)))
|
||
(pop-to-buffer entry-buffer)
|
||
(po-cycle-auxiliary)
|
||
(pop-to-buffer buffer)))
|
||
|
||
(defun po-select-auxiliary ()
|
||
"Select one of the available auxiliary files and locate an equivalent entry.
|
||
If an entry having the same 'msgid' cannot be found, merely select the file
|
||
without moving its cursor."
|
||
(interactive)
|
||
(po-find-span-of-entry)
|
||
(if po-auxiliary-list
|
||
(let ((string (buffer-substring po-start-of-msgid po-start-of-msgstr))
|
||
(name (car (assoc (completing-read (_"Which auxiliary file? ")
|
||
po-auxiliary-list nil t)
|
||
po-auxiliary-list))))
|
||
(po-consider-as-auxiliary)
|
||
(or (po-seek-equivalent-translation name string)
|
||
(find-file name)))))
|
||
|
||
;;; Original program sources as context.
|
||
|
||
(defun po-show-source-path ()
|
||
"Echo the current source search path in the message area."
|
||
(if po-search-path
|
||
(let ((cursor po-search-path)
|
||
string)
|
||
(while cursor
|
||
(setq string (concat string (if string " ") (car (car cursor)))
|
||
cursor (cdr cursor)))
|
||
(message string))
|
||
(message (_"Empty source path."))))
|
||
|
||
(defun po-consider-source-path (directory)
|
||
"Add a given DIRECTORY, requested interactively, to the source search path."
|
||
(interactive "DDirectory for search path: ")
|
||
(setq po-search-path (cons (list (if (string-match "/$" directory)
|
||
directory
|
||
(concat directory "/")))
|
||
po-search-path))
|
||
(setq po-reference-check 0)
|
||
(po-show-source-path))
|
||
|
||
(defun po-ignore-source-path ()
|
||
"Delete a directory, selected with completion, from the source search path."
|
||
(interactive)
|
||
(setq po-search-path
|
||
(delete (list (completing-read (_"Directory to remove? ")
|
||
po-search-path nil t))
|
||
po-search-path))
|
||
(setq po-reference-check 0)
|
||
(po-show-source-path))
|
||
|
||
(defun po-ensure-source-references ()
|
||
"Extract all references into a list, with paths resolved, if necessary."
|
||
(po-find-span-of-entry)
|
||
(if (= po-start-of-entry po-reference-check)
|
||
nil
|
||
(setq po-reference-alist nil)
|
||
(save-excursion
|
||
(goto-char po-start-of-entry)
|
||
(if (re-search-forward "^#:" po-start-of-msgid t)
|
||
(let (current name line path file)
|
||
(while (looking-at "\\(\n#:\\)? *\\([^: ]*\\):\\([0-9]+\\)")
|
||
(goto-char (match-end 0))
|
||
(setq name (po-match-string 2)
|
||
line (po-match-string 3)
|
||
path po-search-path)
|
||
(if (string-equal name "")
|
||
nil
|
||
(while (and (not (file-exists-p
|
||
(setq file (concat (car (car path)) name))))
|
||
path)
|
||
(setq path (cdr path)))
|
||
(setq current (and path file)))
|
||
(if current
|
||
(setq po-reference-alist
|
||
(cons (list (concat current ":" line)
|
||
current
|
||
(string-to-number line))
|
||
po-reference-alist)))))))
|
||
(setq po-reference-alist (nreverse po-reference-alist)
|
||
po-reference-cursor po-reference-alist
|
||
po-reference-check po-start-of-entry)))
|
||
|
||
(defun po-show-source-context (triplet)
|
||
"Show the source context given a TRIPLET which is (PROMPT FILE LINE)."
|
||
(find-file-other-window (car (cdr triplet)))
|
||
(goto-line (car (cdr (cdr triplet))))
|
||
(other-window 1)
|
||
(let ((maximum 0)
|
||
position
|
||
(cursor po-reference-alist))
|
||
(while (not (eq triplet (car cursor)))
|
||
(setq maximum (1+ maximum)
|
||
cursor (cdr cursor)))
|
||
(setq position (1+ maximum)
|
||
po-reference-cursor cursor)
|
||
(while cursor
|
||
(setq maximum (1+ maximum)
|
||
cursor (cdr cursor)))
|
||
(message (_"Displaying %d/%d: \"%s\"") position maximum (car triplet))))
|
||
|
||
(defun po-cycle-source-reference ()
|
||
"Display some source context for the current entry.
|
||
If the command is repeated many times in a row, cycle through contexts."
|
||
(interactive)
|
||
(po-ensure-source-references)
|
||
(if po-reference-cursor
|
||
(po-show-source-context
|
||
(car (if (eq last-command 'po-cycle-source-reference)
|
||
(or (cdr po-reference-cursor) po-reference-alist)
|
||
po-reference-cursor)))
|
||
(error (_"No resolved source references"))))
|
||
|
||
(defun po-select-source-reference ()
|
||
"Select one of the available source contexts for the current entry."
|
||
(interactive)
|
||
(po-ensure-source-references)
|
||
(if po-reference-alist
|
||
(po-show-source-context
|
||
(assoc
|
||
(completing-read (_"Which source context? ") po-reference-alist nil t)
|
||
po-reference-alist))
|
||
(error (_"No resolved source references"))))
|
||
|
||
;;; String marking in program sources, through TAGS table.
|
||
|
||
;; Globally defined within tags.el.
|
||
(defvar tags-loop-operate)
|
||
(defvar tags-loop-scan)
|
||
|
||
;; Locally set in each program source buffer.
|
||
(defvar po-find-string-function)
|
||
(defvar po-mark-string-function)
|
||
|
||
;; Dynamically set within po-tags-search for po-tags-loop-operate.
|
||
(defvar po-current-po-buffer)
|
||
(defvar po-current-po-keywords)
|
||
|
||
(defun po-tags-search (restart)
|
||
"Find an unmarked translatable string through all files in tags table.
|
||
Disregard some simple strings which are most probably non-translatable.
|
||
With prefix argument, restart search at first file."
|
||
(interactive "P")
|
||
(require 'etags)
|
||
;; Ensure there is no highlighting, in case the search fails.
|
||
(if po-highlighting
|
||
(po-dehighlight po-marking-overlay))
|
||
(setq po-string-contents nil)
|
||
;; Search for a string which might later be marked for translation.
|
||
(let ((po-current-po-buffer (current-buffer))
|
||
(po-current-po-keywords po-keywords))
|
||
(pop-to-buffer po-string-buffer)
|
||
(if (and (not restart)
|
||
(eq (car tags-loop-operate) 'po-tags-loop-operate))
|
||
;; Continue last po-tags-search.
|
||
(tags-loop-continue nil)
|
||
;; Start or restart po-tags-search all over.
|
||
(setq tags-loop-scan '(po-tags-loop-scan)
|
||
tags-loop-operate '(po-tags-loop-operate))
|
||
(tags-loop-continue t))
|
||
(select-window (get-buffer-window po-current-po-buffer)))
|
||
(if po-string-contents
|
||
(let ((window (selected-window))
|
||
(buffer po-string-buffer)
|
||
(start po-string-start)
|
||
(end po-string-end))
|
||
;; Try to fit the string in the displayed part of its window.
|
||
(select-window (get-buffer-window buffer))
|
||
(goto-char start)
|
||
(or (pos-visible-in-window-p start)
|
||
(recenter '(nil)))
|
||
(if (pos-visible-in-window-p end)
|
||
(goto-char end)
|
||
(goto-char end)
|
||
(recenter -1))
|
||
(select-window window)
|
||
;; Highlight the string as found.
|
||
(and po-highlighting
|
||
(po-highlight po-marking-overlay start end buffer)))))
|
||
|
||
(defun po-tags-loop-scan ()
|
||
"Decide if the current buffer is still interesting for PO mode strings."
|
||
;; We have little choice, here. The major mode is needed to dispatch to the
|
||
;; proper scanner, so we declare all files as interesting, to force Emacs
|
||
;; tags module to revisit files fully. po-tags-loop-operate sets point at
|
||
;; end of buffer when it is done with a file.
|
||
(not (eobp)))
|
||
|
||
(defun po-tags-loop-operate ()
|
||
"Find an acceptable tag in the current buffer, according to mode.
|
||
Disregard some simple strings which are most probably non-translatable."
|
||
(po-preset-string-functions)
|
||
(let ((continue t)
|
||
data)
|
||
(while continue
|
||
(setq data (apply po-find-string-function po-current-po-keywords nil))
|
||
(if data
|
||
;; Push the string just found into a work buffer for study.
|
||
(po-with-temp-buffer
|
||
(insert (nth 0 data))
|
||
(goto-char (point-min))
|
||
;; Accept if at least three letters in a row.
|
||
(if (re-search-forward "[A-Za-z][A-Za-z][A-Za-z]" nil t)
|
||
(setq continue nil)
|
||
;; Disregard if single letters or no letters at all.
|
||
(if (re-search-forward "[A-Za-z][A-Za-z]" nil t)
|
||
;; Here, we have two letters in a row, but never more.
|
||
;; Accept only if more letters than punctuations.
|
||
(let ((total (buffer-size)))
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "[A-Za-z]+" nil t)
|
||
(replace-match "" t t))
|
||
(if (< (* 2 (buffer-size)) total)
|
||
(setq continue nil))))))
|
||
;; No string left in this buffer.
|
||
(setq continue nil)))
|
||
(if data
|
||
;; Save information for marking functions.
|
||
(let ((buffer (current-buffer)))
|
||
(save-excursion
|
||
(set-buffer po-current-po-buffer)
|
||
(setq po-string-contents (nth 0 data)
|
||
po-string-buffer buffer
|
||
po-string-start (nth 1 data)
|
||
po-string-end (nth 2 data))))
|
||
(goto-char (point-max)))
|
||
;; If nothing was found, trigger scanning of next file.
|
||
(not data)))
|
||
|
||
(defun po-mark-found-string (keyword)
|
||
"Mark last found string in program sources as translatable, using KEYWORD."
|
||
(if (not po-string-contents)
|
||
(error (_"No such string")))
|
||
(and po-highlighting (po-dehighlight po-marking-overlay))
|
||
(let ((contents po-string-contents)
|
||
(buffer po-string-buffer)
|
||
(start po-string-start)
|
||
(end po-string-end)
|
||
line string)
|
||
;; Mark string in program sources.
|
||
(save-excursion
|
||
(set-buffer buffer)
|
||
(setq line (count-lines (point-min) start))
|
||
(apply po-mark-string-function start end keyword nil))
|
||
;; Add PO file entry.
|
||
(let ((buffer-read-only po-read-only))
|
||
(goto-char (point-max))
|
||
(insert "\n" (format "#: %s:%d\n"
|
||
(buffer-file-name po-string-buffer)
|
||
line))
|
||
(save-excursion
|
||
(insert (po-eval-requoted contents "msgid" nil) "msgstr \"\"\n"))
|
||
(setq po-untranslated-counter (1+ po-untranslated-counter))
|
||
(po-update-mode-line-string))
|
||
(setq po-string-contents nil)))
|
||
|
||
(defun po-mark-translatable ()
|
||
"Mark last found string in program sources as translatable, using '_'."
|
||
(interactive)
|
||
(po-mark-found-string "_"))
|
||
|
||
(defun po-select-mark-and-mark (arg)
|
||
"Mark last found string in program sources as translatable, ask for keywoard,
|
||
using completion. With prefix argument, just ask the name of a preferred
|
||
keyword for subsequent commands, also added to possible completions."
|
||
(interactive "P")
|
||
(if arg
|
||
(let ((keyword (list (read-from-minibuffer (_"Keyword: ")))))
|
||
(setq po-keywords (cons keyword (delete keyword po-keywords))))
|
||
(or po-string-contents (error (_"No such string")))
|
||
(let* ((default (car (car po-keywords)))
|
||
(keyword (completing-read (format (_"Mark with keywoard? [%s] ")
|
||
default)
|
||
po-keywords nil t )))
|
||
(if (string-equal keyword "") (setq keyword default))
|
||
(po-mark-found-string keyword))))
|
||
|
||
;;; Unknown mode specifics.
|
||
|
||
(defun po-preset-string-functions ()
|
||
"Preset FIND-STRING-FUNCTION and MARK-STRING-FUNCTION according to mode.
|
||
These variables are locally set in source buffer only when not already bound."
|
||
(let ((pair (cond ((string-equal mode-name "AWK")
|
||
'(po-find-awk-string . po-mark-awk-string))
|
||
((member mode-name '("C" "C++"))
|
||
'(po-find-c-string . po-mark-c-string))
|
||
((string-equal mode-name "Emacs-Lisp")
|
||
'(po-find-emacs-lisp-string . po-mark-emacs-lisp-string))
|
||
((string-equal mode-name "Python")
|
||
'(po-find-python-string . po-mark-python-string))
|
||
((and (string-equal mode-name "Shell-script")
|
||
(string-equal mode-line-process "[bash]"))
|
||
'(po-find-bash-string . po-mark-bash-string))
|
||
(t '(po-find-unknown-string . po-mark-unknown-string)))))
|
||
(or (boundp 'po-find-string-function)
|
||
(set (make-local-variable 'po-find-string-function) (car pair)))
|
||
(or (boundp 'po-mark-string-function)
|
||
(set (make-local-variable 'po-mark-string-function) (cdr pair)))))
|
||
|
||
(defun po-find-unknown-string (keywords)
|
||
"Dummy function to skip over a file, finding no string in it."
|
||
nil)
|
||
|
||
(defun po-mark-unknown-string (start end keyword)
|
||
"Dummy function to mark a given string. May not be called."
|
||
(error (_"Dummy function called")))
|
||
|
||
;;; Awk mode specifics.
|
||
|
||
(defun po-find-awk-string (keywords)
|
||
"Find the next Awk string, excluding those marked by any of KEYWORDS.
|
||
Return (CONTENTS START END) for the found string, or nil if none found."
|
||
(let (start end)
|
||
(while (and (not start)
|
||
(re-search-forward "[#/\"]" nil t))
|
||
(cond ((= (preceding-char) ?#)
|
||
;; Disregard comments.
|
||
(or (search-forward "\n" nil t)
|
||
(goto-char (point-max))))
|
||
((= (preceding-char) ?/)
|
||
;; Skip regular expressions.
|
||
(while (not (= (following-char) ?/))
|
||
(skip-chars-forward "^/\\\\")
|
||
(if (= (following-char) ?\\) (forward-char 2)))
|
||
(forward-char 1))
|
||
;; Else find the end of the string.
|
||
(t (setq start (1- (point)))
|
||
(while (not (= (following-char) ?\"))
|
||
(skip-chars-forward "^\"\\\\")
|
||
(if (= (following-char) ?\\) (forward-char 2)))
|
||
(forward-char 1)
|
||
(setq end (point))
|
||
;; Check before string either for underline, or for keyword
|
||
;; and opening parenthesis.
|
||
(save-excursion
|
||
(goto-char start)
|
||
(cond ((= (preceding-char) ?_)
|
||
;; Disregard already marked strings.
|
||
(setq start nil
|
||
end nil))
|
||
((= (preceding-char) ?\()
|
||
(backward-char 1)
|
||
(let ((end-keyword (point)))
|
||
(skip-chars-backward "_A-Za-z0-9")
|
||
(if (member (list (po-buffer-substring
|
||
(point) end-keyword))
|
||
keywords)
|
||
;; Disregard already marked strings.
|
||
(setq start nil
|
||
end nil)))))))))
|
||
(and start end
|
||
(list (po-extract-unquoted (current-buffer) start end) start end))))
|
||
|
||
(defun po-mark-awk-string (start end keyword)
|
||
"Mark the Awk string, from START to END, with KEYWORD.
|
||
Leave point after marked string."
|
||
(if (string-equal keyword "_")
|
||
(progn
|
||
(goto-char start)
|
||
(insert "_")
|
||
(goto-char (1+ end)))
|
||
(goto-char end)
|
||
(insert ")")
|
||
(save-excursion
|
||
(goto-char start)
|
||
(insert keyword "("))))
|
||
|
||
;;; Bash mode specifics.
|
||
|
||
(defun po-find-bash-string (keywords)
|
||
"Find the next unmarked Bash string. KEYWORDS are merely ignored.
|
||
Return (CONTENTS START END) for the found string, or nil if none found."
|
||
(let (start end)
|
||
(while (and (not start)
|
||
(re-search-forward "[#'\"]" nil t))
|
||
(cond ((= (preceding-char) ?#)
|
||
;; Disregard comments.
|
||
(or (search-forward "\n" nil t)
|
||
(goto-char (point-max))))
|
||
((= (preceding-char) ?')
|
||
;; Skip single quoted strings.
|
||
(while (not (= (following-char) ?'))
|
||
(skip-chars-forward "^'\\\\")
|
||
(if (= (following-char) ?\\) (forward-char 2)))
|
||
(forward-char 1))
|
||
;; Else find the end of the double quoted string.
|
||
(t (setq start (1- (point)))
|
||
(while (not (= (following-char) ?\"))
|
||
(skip-chars-forward "^\"\\\\")
|
||
(if (= (following-char) ?\\) (forward-char 2)))
|
||
(forward-char 1)
|
||
(setq end (point))
|
||
;; Check before string for dollar sign.
|
||
(save-excursion
|
||
(goto-char start)
|
||
(if (= (preceding-char) ?$)
|
||
;; Disregard already marked strings.
|
||
(setq start nil
|
||
end nil))))))
|
||
(and start end
|
||
(list (po-extract-unquoted (current-buffer) start end) start end))))
|
||
|
||
(defun po-mark-bash-string (start end keyword)
|
||
"Mark the Bash string, from START to END, with '$'. KEYWORD is ignored.
|
||
Leave point after marked string."
|
||
(goto-char start)
|
||
(insert "$")
|
||
(goto-char (1+ end)))
|
||
|
||
;;; C or C++ mode specifics.
|
||
|
||
;;; A few long string cases (submitted by Ben Pfaff).
|
||
|
||
;; #define string "This is a long string " \
|
||
;; "that is continued across several lines " \
|
||
;; "in a macro in order to test \\ quoting\\" \
|
||
;; "\\ with goofy strings.\\"
|
||
|
||
;; char *x = "This is just an ordinary string "
|
||
;; "continued across several lines without needing "
|
||
;; "to use \\ characters at end-of-line.";
|
||
|
||
;; char *y = "Here is a string continued across \
|
||
;; several lines in the manner that was sanctioned \
|
||
;; in K&R C compilers and still works today, \
|
||
;; even though the method used above is more esthetic.";
|
||
|
||
;;; End of long string cases.
|
||
|
||
(defun po-find-c-string (keywords)
|
||
"Find the next C string, excluding those marked by any of KEYWORDS.
|
||
Returns (CONTENTS START END) for the found string, or nil if none found."
|
||
(let (start end)
|
||
(while (and (not start)
|
||
(re-search-forward "\\([\"']\\|/\\*\\|//\\)" nil t))
|
||
(cond ((= (preceding-char) ?*)
|
||
;; Disregard comments.
|
||
(search-forward "*/"))
|
||
((= (preceding-char) ?/)
|
||
;; Disregard C++ comments.
|
||
(end-of-line)
|
||
(forward-char 1))
|
||
((= (preceding-char) ?\')
|
||
;; Disregard character constants.
|
||
(forward-char (if (= (following-char) ?\\) 3 2)))
|
||
((save-excursion
|
||
(beginning-of-line)
|
||
(looking-at "^# *\\(include\\|line\\)"))
|
||
;; Disregard lines being #include or #line directives.
|
||
(end-of-line))
|
||
;; Else, find the end of the (possibly concatenated) string.
|
||
(t (setq start (1- (point))
|
||
end nil)
|
||
(while (not end)
|
||
(cond ((= (following-char) ?\")
|
||
(if (looking-at "\"[ \t\n\\\\]*\"")
|
||
(goto-char (match-end 0))
|
||
(forward-char 1)
|
||
(setq end (point))))
|
||
((= (following-char) ?\\) (forward-char 2))
|
||
(t (skip-chars-forward "^\"\\\\"))))
|
||
;; Check before string for keyword and opening parenthesis.
|
||
(goto-char start)
|
||
(skip-chars-backward " \n\t")
|
||
(if (= (preceding-char) ?\()
|
||
(progn
|
||
(backward-char 1)
|
||
(skip-chars-backward " \n\t")
|
||
(let ((end-keyword (point)))
|
||
(skip-chars-backward "_A-Za-z0-9")
|
||
(if (member (list (po-buffer-substring (point)
|
||
end-keyword))
|
||
keywords)
|
||
;; Disregard already marked strings.
|
||
(progn
|
||
(goto-char end)
|
||
(setq start nil
|
||
end nil))
|
||
;; String found. Prepare to resume search.
|
||
(goto-char end))))
|
||
;; String found. Prepare to resume search.
|
||
(goto-char end)))))
|
||
;; Return the found string, if any.
|
||
(and start end
|
||
(list (po-extract-unquoted (current-buffer) start end) start end))))
|
||
|
||
(defun po-mark-c-string (start end keyword)
|
||
"Mark the C string, from START to END, with KEYWORD.
|
||
Leave point after marked string."
|
||
(goto-char end)
|
||
(insert ")")
|
||
(save-excursion
|
||
(goto-char start)
|
||
(insert keyword)
|
||
(or (string-equal keyword "_") (insert " "))
|
||
(insert "(")))
|
||
|
||
;;; Emacs LISP mode specifics.
|
||
|
||
(defun po-find-emacs-lisp-string (keywords)
|
||
"Find the next Emacs LISP string, excluding those marked by any of KEYWORDS.
|
||
Returns (CONTENTS START END) for the found string, or nil if none found."
|
||
(let (start end)
|
||
(while (and (not start)
|
||
(re-search-forward "[;\"?]" nil t))
|
||
(cond ((= (preceding-char) ?\;)
|
||
;; Disregard comments.
|
||
(search-forward "\n"))
|
||
((= (preceding-char) ?\?)
|
||
;; Disregard character constants.
|
||
(forward-char (if (= (following-char) ?\\) 2 1)))
|
||
;; Else, find the end of the string.
|
||
(t (setq start (1- (point)))
|
||
(while (not (= (following-char) ?\"))
|
||
(skip-chars-forward "^\"\\\\")
|
||
(if (= (following-char) ?\\) (forward-char 2)))
|
||
(forward-char 1)
|
||
(setq end (point))
|
||
;; Check before string for keyword and opening parenthesis.
|
||
(goto-char start)
|
||
(skip-chars-backward " \n\t")
|
||
(let ((end-keyword (point)))
|
||
(skip-chars-backward "-_A-Za-z0-9")
|
||
(if (and (= (preceding-char) ?\()
|
||
(member (list (po-buffer-substring (point)
|
||
end-keyword))
|
||
keywords))
|
||
;; Disregard already marked strings.
|
||
(progn
|
||
(goto-char end)
|
||
(setq start nil
|
||
end nil)))))))
|
||
;; Return the found string, if any.
|
||
(and start end
|
||
(list (po-extract-unquoted (current-buffer) start end) start end))))
|
||
|
||
(defun po-mark-emacs-lisp-string (start end keyword)
|
||
"Mark the Emacs LISP string, from START to END, with KEYWORD.
|
||
Leave point after marked string."
|
||
(goto-char end)
|
||
(insert ")")
|
||
(save-excursion
|
||
(goto-char start)
|
||
(insert "(" keyword)
|
||
(or (string-equal keyword "_") (insert " "))))
|
||
|
||
;;; Python mode specifics.
|
||
|
||
(defun po-find-python-string (keywords)
|
||
"Find the next Python string, excluding those marked by any of KEYWORDS.
|
||
Also disregard strings when preceded by an empty string of the other type.
|
||
Returns (CONTENTS START END) for the found string, or nil if none found."
|
||
(let (contents start end)
|
||
(while (and (not contents)
|
||
(re-search-forward "[#\"']" nil t))
|
||
(forward-char -1)
|
||
(cond ((= (following-char) ?\#)
|
||
;; Disregard comments.
|
||
(search-forward "\n"))
|
||
((looking-at "\"\"'")
|
||
;; Quintuple-quoted string
|
||
(po-skip-over-python-string))
|
||
((looking-at "''\"")
|
||
;; Quadruple-quoted string
|
||
(po-skip-over-python-string))
|
||
(t
|
||
;; Simple-, double-, triple- or sextuple-quoted string.
|
||
(if (memq (preceding-char) '(?r ?R))
|
||
(forward-char -1))
|
||
(setq start (point)
|
||
contents (po-skip-over-python-string)
|
||
end (point))
|
||
(goto-char start)
|
||
(skip-chars-backward " \n\t")
|
||
(cond ((= (preceding-char) ?\[)
|
||
;; Disregard a string used as a dictionary index.
|
||
(setq contents nil))
|
||
((= (preceding-char) ?\()
|
||
;; Isolate the keyword which precedes string.
|
||
(backward-char 1)
|
||
(skip-chars-backward " \n\t")
|
||
(let ((end-keyword (point)))
|
||
(skip-chars-backward "_A-Za-z0-9")
|
||
(if (member (list (po-buffer-substring (point)
|
||
end-keyword))
|
||
keywords)
|
||
;; Disregard already marked strings.
|
||
(setq contents nil)))))
|
||
(goto-char end))))
|
||
;; Return the found string, if any.
|
||
(and contents (list contents start end))))
|
||
|
||
(defun po-skip-over-python-string ()
|
||
"Skip over a Python string, possibly made up of many concatenated parts.
|
||
Leave point after string. Return unquoted overall string contents."
|
||
(let ((continue t)
|
||
(contents "")
|
||
raw start end resume)
|
||
(while continue
|
||
(skip-chars-forward " \t\n") ; whitespace
|
||
(cond ((= (following-char) ?#) ; comment
|
||
(setq start nil)
|
||
(search-forward "\n"))
|
||
((looking-at "\\\n") ; escaped newline
|
||
(setq start nil)
|
||
(forward-char 2))
|
||
((looking-at "[rR]?\"\"\"") ; sextuple-quoted string
|
||
(setq raw (memq (following-char) '(?r ?R))
|
||
start (match-end 0))
|
||
(goto-char start)
|
||
(search-forward "\"\"\"")
|
||
(setq resume (point)
|
||
end (- resume 3)))
|
||
((looking-at "[rr]?'''") ; triple-quoted string
|
||
(setq raw (memq (following-char) '(?r ?R))
|
||
start (match-end 0))
|
||
(goto-char start)
|
||
(search-forward "'''")
|
||
(setq resume (point)
|
||
end (- resume 3)))
|
||
((looking-at "[rR]?\"") ; double-quoted string
|
||
(setq raw (memq (following-char) '(?r ?R))
|
||
start (match-end 0))
|
||
(goto-char start)
|
||
(while (not (memq (following-char) '(0 ?\")))
|
||
(skip-chars-forward "^\"\\\\")
|
||
(if (= (following-char) ?\\) (forward-char 2)))
|
||
(if (eobp)
|
||
(setq contents nil
|
||
start nil)
|
||
(setq end (point))
|
||
(forward-char 1))
|
||
(setq resume (point)))
|
||
((looking-at "[rR]?'") ; single-quoted string
|
||
(setq raw (memq (following-char) '(?r ?R))
|
||
start (match-end 0))
|
||
(goto-char start)
|
||
(while (not (memq (following-char) '(0 ?\')))
|
||
(skip-chars-forward "^'\\\\")
|
||
(if (= (following-char) ?\\) (forward-char 2)))
|
||
(if (eobp)
|
||
(setq contents nil
|
||
start nil)
|
||
(setq end (point))
|
||
(forward-char 1))
|
||
(setq resume (point)))
|
||
(t ; no string anymore
|
||
(setq start nil
|
||
continue nil)))
|
||
(if start
|
||
(setq contents (concat contents
|
||
(if raw
|
||
(buffer-substring start end)
|
||
(po-extract-part-unquoted (current-buffer)
|
||
start end))))))
|
||
(goto-char resume)
|
||
contents))
|
||
|
||
(defun po-mark-python-string (start end keyword)
|
||
"Mark the Python string, from START to END, with KEYWORD.
|
||
If KEYWORD is '.', prefix the string with an empty string of the other type.
|
||
Leave point after marked string."
|
||
(cond ((string-equal keyword ".")
|
||
(goto-char end)
|
||
(save-excursion
|
||
(goto-char start)
|
||
(insert (cond ((= (following-char) ?\') "\"\"")
|
||
((= (following-char) ?\") "''")
|
||
(t "??")))))
|
||
(t (goto-char end)
|
||
(insert ")")
|
||
(save-excursion
|
||
(goto-char start)
|
||
(insert keyword "(")))))
|
||
|
||
;;; Miscellaneous features.
|
||
|
||
(defun po-help ()
|
||
"Provide an help window for PO mode."
|
||
(interactive)
|
||
(po-with-temp-buffer
|
||
(insert po-help-display-string)
|
||
(goto-char (point-min))
|
||
(save-window-excursion
|
||
(switch-to-buffer (current-buffer))
|
||
(delete-other-windows)
|
||
(message (_"Type any character to continue"))
|
||
(po-read-event))))
|
||
|
||
(defun po-undo ()
|
||
"Undo the last change to the PO file."
|
||
(interactive)
|
||
(let ((buffer-read-only po-read-only))
|
||
(undo))
|
||
(po-compute-counters nil))
|
||
|
||
(defun po-statistics ()
|
||
"Say how many entries in each category, and the current position."
|
||
(interactive)
|
||
(po-compute-counters t))
|
||
|
||
(defun po-validate ()
|
||
"Use 'msgfmt' for validating the current PO file contents."
|
||
(interactive)
|
||
(let* ((dev-null
|
||
(cond ((boundp 'null-device) null-device) ; since Emacs 20.3
|
||
((memq system-type '(windows-nt windows-95)) "NUL")
|
||
(t "/dev/null")))
|
||
(compilation-buffer-name-function
|
||
(function (lambda (mode-name)
|
||
(concat "*" mode-name " validation*"))))
|
||
(compile-command (concat po-msgfmt-program
|
||
" --statistics -c -v -o " dev-null " "
|
||
buffer-file-name)))
|
||
(po-msgfmt-version-check)
|
||
(compile compile-command)))
|
||
|
||
(defvar po-msgfmt-version-checked nil)
|
||
(defun po-msgfmt-version-check ()
|
||
"'msgfmt' from GNU gettext 0.10.36 or greater is required."
|
||
(po-with-temp-buffer
|
||
(or
|
||
;; Don't bother checking again.
|
||
po-msgfmt-version-checked
|
||
|
||
(and
|
||
;; Make sure 'msgfmt' is available.
|
||
(condition-case nil
|
||
(call-process po-msgfmt-program
|
||
nil t nil "--verbose" "--version")
|
||
(file-error nil))
|
||
|
||
;; Make sure there's a version number in the output:
|
||
;; 0.11 or 0.10.36 or 0.11-pre1
|
||
(progn (goto-char (point-min))
|
||
(or (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)$")
|
||
(looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$")
|
||
(looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)[-_A-Za-z0-9]+$")))
|
||
|
||
;; Make sure the version is recent enough.
|
||
(>= (string-to-number
|
||
(format "%d%03d%03d"
|
||
(string-to-number (match-string 1))
|
||
(string-to-number (match-string 2))
|
||
(string-to-number (or (match-string 3) "0"))))
|
||
010036)
|
||
|
||
;; Remember the outcome.
|
||
(setq po-msgfmt-version-checked t))
|
||
|
||
(error (_"'msgfmt' from GNU gettext 0.10.36 or greater is required")))))
|
||
|
||
(defun po-guess-archive-name ()
|
||
"Return the ideal file name for this PO file in the central archives."
|
||
(let ((filename (file-name-nondirectory buffer-file-name))
|
||
start-of-header end-of-header package version team)
|
||
(save-excursion
|
||
;; Find the PO file header entry.
|
||
(goto-char (point-min))
|
||
(re-search-forward po-any-msgstr-regexp)
|
||
(setq start-of-header (match-beginning 0)
|
||
end-of-header (match-end 0))
|
||
;; Get the package and version.
|
||
(goto-char start-of-header)
|
||
(if (re-search-forward "\n\
|
||
\"Project-Id-Version: \\(GNU \\|Free \\)?\\([^\n ]+\\) \\([^\n ]+\\)\\\\n\"$"
|
||
end-of-header t)
|
||
(setq package (po-match-string 2)
|
||
version (po-match-string 3)))
|
||
(if (or (not package) (string-equal package "PACKAGE")
|
||
(not version) (string-equal version "VERSION"))
|
||
(error (_"Project-Id-Version field does not have a proper value")))
|
||
;; File name version and Project-Id-Version must match
|
||
(cond (;; A `filename' w/o package and version info at all
|
||
(string-match "^[^\\.]*\\.po\\'" filename))
|
||
(;; TP Robot compatible `filename': PACKAGE-VERSION.LL.po
|
||
(string-match (concat (regexp-quote package)
|
||
"-\\(.*\\)\\.[^\\.]*\\.po\\'") filename)
|
||
(if (not (equal version (po-match-string 1 filename)))
|
||
(error (_"\
|
||
Version mismatch: file name: %s; header: %s.\n\
|
||
Adjust Project-Id-Version field to match file name and try again")
|
||
(po-match-string 1 filename) version))))
|
||
;; Get the team.
|
||
(if (stringp po-team-name-to-code)
|
||
(setq team po-team-name-to-code)
|
||
(goto-char start-of-header)
|
||
(if (re-search-forward "\n\
|
||
\"Language-Team: \\([^ ].*[^ ]\\) <.+@.+>\\\\n\"$"
|
||
end-of-header t)
|
||
(let ((name (po-match-string 1)))
|
||
(if name
|
||
(let ((pair (assoc name po-team-name-to-code)))
|
||
(if pair
|
||
(setq team (cdr pair))
|
||
(setq team (read-string (format "\
|
||
Team name '%s' unknown. What is the team code? "
|
||
name)))))))))
|
||
(if (or (not team) (string-equal team "LL"))
|
||
(error (_"Language-Team field does not have a proper value")))
|
||
;; Compose the name.
|
||
(concat package "-" version "." team ".po"))))
|
||
|
||
(defun po-guess-team-address ()
|
||
"Return the team address related to this PO file."
|
||
(let (team)
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(re-search-forward po-any-msgstr-regexp)
|
||
(goto-char (match-beginning 0))
|
||
(if (re-search-forward
|
||
"\n\"Language-Team: +\\(.*<\\(.*\\)@.*>\\)\\\\n\"$"
|
||
(match-end 0) t)
|
||
(setq team (po-match-string 2)))
|
||
(if (or (not team) (string-equal team "LL"))
|
||
(error (_"Language-Team field does not have a proper value")))
|
||
(po-match-string 1))))
|
||
|
||
(defun po-send-mail ()
|
||
"Start composing a letter, possibly including the current PO file."
|
||
(interactive)
|
||
(let* ((team-flag (y-or-n-p
|
||
(_"\
|
||
Write to your team? ('n' if writing to the Translation Project robot) ")))
|
||
(address (if team-flag
|
||
(po-guess-team-address)
|
||
po-translation-project-address)))
|
||
(if (not (y-or-n-p (_"Include current PO file in mail? ")))
|
||
(apply po-compose-mail-function address
|
||
(read-string (_"Subject? ")) nil)
|
||
(if (buffer-modified-p)
|
||
(error (_"The file is not even saved, you did not validate it.")))
|
||
(if (and (y-or-n-p (_"You validated ('V') this file, didn't you? "))
|
||
(or (zerop po-untranslated-counter)
|
||
(y-or-n-p
|
||
(format (_"%d entries are untranslated, include anyway? ")
|
||
po-untranslated-counter)))
|
||
(or (zerop po-fuzzy-counter)
|
||
(y-or-n-p
|
||
(format (_"%d entries are still fuzzy, include anyway? ")
|
||
po-fuzzy-counter)))
|
||
(or (zerop po-obsolete-counter)
|
||
(y-or-n-p
|
||
(format (_"%d entries are obsolete, include anyway? ")
|
||
po-obsolete-counter))))
|
||
(let ((buffer (current-buffer))
|
||
(name (po-guess-archive-name))
|
||
(transient-mark-mode nil)
|
||
(coding-system-for-read buffer-file-coding-system)
|
||
(coding-system-for-write buffer-file-coding-system))
|
||
(apply po-compose-mail-function address
|
||
(if team-flag
|
||
(read-string (_"Subject? "))
|
||
(format "%s %s" po-translation-project-mail-label name))
|
||
nil)
|
||
(goto-char (point-min))
|
||
(re-search-forward
|
||
(concat "^" (regexp-quote mail-header-separator) "\n"))
|
||
(save-excursion
|
||
(insert-buffer buffer)
|
||
(shell-command-on-region
|
||
(region-beginning) (region-end)
|
||
(concat po-gzip-uuencode-command " " name ".gz") t))))))
|
||
(message ""))
|
||
|
||
(defun po-confirm-and-quit ()
|
||
"Confirm if quit should be attempted and then, do it.
|
||
This is a failsafe. Confirmation is asked if only the real quit would not."
|
||
(interactive)
|
||
(if (po-check-all-pending-edits)
|
||
(progn
|
||
(if (or (buffer-modified-p)
|
||
(> po-untranslated-counter 0)
|
||
(> po-fuzzy-counter 0)
|
||
(> po-obsolete-counter 0)
|
||
(y-or-n-p (_"Really quit editing this PO file? ")))
|
||
(po-quit))
|
||
(message ""))))
|
||
|
||
(defun po-quit ()
|
||
"Save the PO file and kill buffer.
|
||
However, offer validation if appropriate and ask confirmation if untranslated
|
||
strings remain."
|
||
(interactive)
|
||
(if (po-check-all-pending-edits)
|
||
(let ((quit t))
|
||
;; Offer validation of newly modified entries.
|
||
(if (and (buffer-modified-p)
|
||
(not (y-or-n-p
|
||
(_"File was modified; skip validation step? "))))
|
||
(progn
|
||
(message "")
|
||
(po-validate)
|
||
;; If we knew that the validation was all successful, we should
|
||
;; just quit. But since we do not know yet, as the validation
|
||
;; might be asynchronous with PO mode commands, the safest is to
|
||
;; stay within PO mode, even if this implies that another
|
||
;; 'po-quit' command will be later required to exit for true.
|
||
(setq quit nil)))
|
||
;; Offer to work on untranslated entries.
|
||
(if (and quit
|
||
(or (> po-untranslated-counter 0)
|
||
(> po-fuzzy-counter 0)
|
||
(> po-obsolete-counter 0))
|
||
(not (y-or-n-p
|
||
(_"Unprocessed entries remain; quit anyway? "))))
|
||
(progn
|
||
(setq quit nil)
|
||
(po-auto-select-entry)))
|
||
;; Clear message area.
|
||
(message "")
|
||
;; Or else, kill buffers and quit for true.
|
||
(if quit
|
||
(progn
|
||
(save-buffer)
|
||
(kill-buffer (current-buffer)))))))
|
||
|
||
(provide 'po-mode)
|
||
|
||
;;; po-mode.el ends here
|