diff options
| -rw-r--r-- | .emacs.d/lisp/po-mode.el | 3427 |
1 files changed, 3427 insertions, 0 deletions
diff --git a/.emacs.d/lisp/po-mode.el b/.emacs.d/lisp/po-mode.el new file mode 100644 index 0000000..e044287 --- /dev/null +++ b/.emacs.d/lisp/po-mode.el @@ -0,0 +1,3427 @@ +;;; po-mode.el --- major mode for GNU gettext PO files + +;; Copyright (C) 1995-2002, 2005-2008, 2010, 2013-2017, 2019-2020 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. + +;; This program 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 3 of the License, or +;; (at your option) any later version. + +;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; 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'. + +;; TODO: +;; Plural form editing: +;; - When in edit mode, currently it highlights (in green) the msgid; +;; it should also highlight the msgid_plural string, I would say, since +;; the translator has to look at both. +;; - After the translator finished the translation of msgstr[0], it would +;; be nice if the cursor would automatically move to the beginning of the +;; msgstr[1] line, so that the translator just needs to press RET to edit +;; that. +;; - If msgstr[1] is empty but msgstr[0] is not, it would be ergonomic if the +;; contents of msgstr[0] would be copied. (Not sure if this should happen +;; at the end of the editing msgstr[0] or at the beginning of the editing +;; of msgstr[1].) Reason: These two strings are usually very similar. + +;;; Code: + +(defconst po-mode-version-string "2.27" "\ +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. + +;; 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-delete-previous-msgid t + "*Automatically delete previous msgid (marked #|) when editing entry. +Value is nil, t, or ask." + :type '(choice (const nil) + (const t) + (const ask)) + :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-keep-mo-file nil + "*Set whether MO file should be kept or discarded after validation." + :type 'boolean + :group 'po) + +(defcustom po-auto-update-file-header t + "*Automatically revise headers. Value is nil, t, or ask." + :type '(choice (const nil) + (const t) + (const ask)) + :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 + "robot@translationproject.org" + "*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'." + :type 'string + :group 'po) + +(defcustom po-highlighting t + "*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, the inverse of + ;; gettext-tools/src/lang-table.c, and a little more. + '(("LANGUAGE" . "LL") + ("(Afan) Oromo" . "om") + ("Abkhazian" . "ab") + ("Achinese" . "ace") + ("Afar" . "aa") + ("Afrikaans" . "af") + ("Akan" . "ak") + ("Albanian" . "sq") + ("Amharic" . "am") + ("Arabic" . "ar") + ("Aragonese" . "an") + ("Argentinian" . "es_AR") + ("Armenian" . "hy") + ("Assamese" . "as") + ("Austrian" . "de_AT") + ("Avaric" . "av") + ("Avestan" . "ae") + ("Awadhi" . "awa") + ("Aymara" . "ay") + ("Azerbaijani" . "az") + ("Balinese" . "ban") + ("Baluchi" . "bal") + ("Bambara" . "bm") + ("Bashkir" . "ba") + ("Basque" . "eu") + ("Beja" . "bej") + ("Belarusian" . "be") + ("Bemba" . "bem") + ("Bengali" . "bn") + ("Bhojpuri" . "bho") + ("Bihari" . "bh") + ("Bikol" . "bik") + ("Bini" . "bin") + ("Bislama" . "bi") + ("Bosnian" . "bs") + ("Brazilian Portuguese" . "pt_BR") + ("Breton" . "br") + ("Buginese" . "bug") + ("Bulgarian" . "bg") + ("Burmese" . "my") + ("Catalan" . "ca") + ("Cebuano" . "ceb") + ("Central Khmer" . "km") + ("Chamorro" . "ch") + ("Chechen" . "ce") + ("Chinese" . "zh") + ("Chinese (Hong Kong)" . "zh_HK") + ("Chinese (simplified)" . "zh_CN") + ("Chinese (traditional)" . "zh_TW") + ("Church Slavic" . "cu") + ("Chuvash" . "cv") + ("Cornish" . "kw") + ("Corsican" . "co") + ("Cree" . "cr") + ("Croatian" . "hr") + ("Czech" . "cs") + ("Danish" . "da") + ("Dinka" . "din") + ("Divehi" . "dv") + ("Dogri" . "doi") + ("Dutch" . "nl") + ("Dzongkha" . "dz") + ("English" . "en") + ("English (British)" . "en_GB") + ("Esperanto" . "eo") + ("Estonian" . "et") + ("Ewe" . "ee") + ("Faroese" . "fo") + ("Fijian" . "fj") + ("Filipino" . "fil") + ("Finnish" . "fi") + ("Fon" . "fon") + ("French" . "fr") + ("Frisian" . "fy") + ("Fulah" . "ff") + ("Galician" . "gl") + ("Ganda" . "lg") + ("Georgian" . "ka") + ("German" . "de") + ("Gondi" . "gon") + ("Greek" . "el") + ("Guarani" . "gn") + ("Gujarati" . "gu") + ("Haitian" . "ht") + ("Hausa" . "ha") + ("Hebrew" . "he") + ("Herero" . "hz") + ("Hiligaynon" . "hil") + ("Hindi" . "hi") + ("Hiri Motu" . "ho") + ("Hmong" . "hmn") + ("Hungarian" . "hu") + ("Hyam" . "jab") + ("Icelandic" . "is") + ("Ido" . "io") + ("Igbo" . "ig") + ("Iloko" . "ilo") + ("Indonesian" . "id") + ("Interlingua" . "ia") + ("Interlingue" . "ie") + ("Inuktitut" . "iu") + ("Inupiak" . "ik") + ("Irish" . "ga") + ("Italian" . "it") + ("Japanese" . "ja") + ("Javanese" . "jv") + ("Jju" . "kaj") + ("Kabardian" . "kbd") + ("Kabyle" . "kab") + ("Kagoma" . "kdm") + ("Kalaallisut" . "kl") + ("Kamba" . "kam") + ("Kannada" . "kn") + ("Kanuri" . "kr") + ("Kashmiri" . "ks") + ("Kashubian" . "csb") + ("Kazakh" . "kk") + ("Khmer" . "km") ; old name + ("Kikuyu" . "ki") + ("Kimbundu" . "kmb") + ("Kinyarwanda" . "rw") + ("Kirghiz" . "ky") + ("Kirundi" . "rn") + ("Komi" . "kv") + ("Kongo" . "kg") + ("Konkani" . "kok") + ("Korean" . "ko") + ("Kuanyama" . "kj") + ("Kurdish" . "ku") + ("Kurukh" . "kru") + ("Laotian" . "lo") + ("Latin" . "la") + ("Latvian" . "lv") + ("Letzeburgesch" . "lb") + ("Limburgish" . "li") + ("Lingala" . "ln") + ("Lithuanian" . "lt") + ("Low Saxon" . "nds") + ("Luba-Katanga" . "lu") + ("Luba-Lulua" . "lua") + ("Luo" . "luo") + ("Macedonian" . "mk") + ("Madurese" . "mad") + ("Magahi" . "mag") + ("Maithili" . "mai") + ("Makasar" . "mak") + ("Malagasy" . "mg") + ("Malay" . "ms") + ("Malayalam" . "ml") + ("Maltese" . "mt") + ("Mandingo" . "man") + ("Manipuri" . "mni") + ("Manx" . "gv") + ("Maori" . "mi") + ("Marathi" . "mr") + ("Marshall" . "mh") + ("Marshallese" . "mh") + ("Marwari" . "mwr") + ("Mayan" . "myn") + ("Mende" . "men") + ("Minangkabau" . "min") + ("Moldavian" . "mo") + ("Mongolian" . "mn") + ("Mossi" . "mos") + ("Nahuatl" . "nah") + ("Nauru" . "na") + ("Navajo" . "nv") + ("Ndonga" . "ng") + ("Neapolitan" . "nap") + ("Nepali" . "ne") + ("North Ndebele" . "nd") + ("Northern Sami" . "se") + ("Northern Sotho" . "nso") + ("Norwegian Bokmal" . "nb") + ("Norwegian Nynorsk" . "nn") + ("Norwegian" . "no") + ("Nyamwezi" . "nym") + ("Nyanja" . "ny") + ("Nyankole" . "nyn") + ("Occitan" . "oc") + ("Ojibwa" . "oj") + ("Old English" . "ang") + ("Oriya" . "or") + ("Ossetian" . "os") + ("Páez" . "pbb") + ("Pali" . "pi") + ("Pampanga" . "pam") + ("Pangasinan" . "pag") + ("Pashto" . "ps") + ("Persian" . "fa") + ("Polish" . "pl") + ("Portuguese" . "pt") + ("Punjabi" . "pa") + ("Quechua" . "qu") + ("Rajasthani" . "raj") + ("Rhaeto-Roman" . "rm") ; old name + ("Romanian" . "ro") + ("Romansh" . "rm") + ("Russian" . "ru") + ("Samoan" . "sm") + ("Sango" . "sg") + ("Sanskrit" . "sa") + ("Santali" . "sat") + ("Sardinian" . "sc") + ("Sasak" . "sas") + ("Scots" . "gd") ; old name + ("Scottish Gaelic" . "gd") + ("Serbian" . "sr") + ("Serer" . "srr") + ("Sesotho" . "st") + ("Setswana" . "tn") + ("Shan" . "shn") + ("Shona" . "sn") + ("Sichuan Yi" . "ii") + ("Sicilian" . "scn") + ("Sidamo" . "sid") + ("Sindhi" . "sd") + ("Sinhala" . "si") + ("Sinhalese" . "si") + ("Siswati" . "ss") + ("Slovak" . "sk") + ("Slovenian" . "sl") + ("Somali" . "so") + ("Sorbian" . "wen") + ("South Ndebele" . "nr") + ("Spanish" . "es") + ("Spanish (Canary Islands)" . "es_IC") + ("Sukuma" . "suk") + ("Sundanese" . "su") + ("Susu" . "sus") + ("Swahili" . "sw") + ("Swedish" . "sv") + ("Swiss German" . "gsw") + ("Tagalog" . "tl") + ("Tahitian" . "ty") + ("Tajik" . "tg") + ("Tamil" . "ta") + ("Tatar" . "tt") + ("Telugu" . "te") + ("Tetum" . "tet") + ("Thai" . "th") + ("Tibetan" . "bo") + ("Tigrinya" . "ti") + ("Timne" . "tem") + ("Tiv" . "tiv") + ("Tonga" . "to") + ("Tsonga" . "ts") + ("Tumbuka" . "tum") + ("Turkish" . "tr") + ("Turkmen" . "tk") + ("Twi" . "tw") + ("Tyap" . "kcg") + ("Uighur" . "ug") + ("Ukrainian" . "uk") + ("Umbundu" . "umb") + ("Urdu" . "ur") + ("Uzbek" . "uz") + ("Venda" . "ve") + ("Vietnamese" . "vi") + ("Volapuk" . "vo") + ("Walloon" . "wa") + ("Walamo" . "wal") + ("Waray" . "war") + ("Welsh" . "cy") + ("Western Frisian" . "fy") + ("Wolof" . "wo") + ("Xhosa" . "xh") + ("Yao" . "yao") + ("Yiddish" . "yi") + ("Yoruba" . "yo") + ("Zapotec" . "zap") + ("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) + (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'. + +(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-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)) + +;;; 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-msgctxt) ; = po-start-of-msgid if there is no msgctxt +(defvar po-start-of-msgid) +(defvar po-start-of-msgid_plural) ; = nil if there is no msgid_plural +(defvar po-start-of-msgstr-block) +(defvar po-start-of-msgstr-form) +(defvar po-end-of-msgstr-form) +(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 + :help "Jump to next interesting entry"] + "---" + ;; Forward + ["Any next" po-next-entry + :help "Jump to next entry"] + ["Next translated" po-next-translated-entry + :help "Jump to next translated entry"] + ["Next fuzzy" po-next-fuzzy-entry + :help "Jump to next fuzzy entry"] + ["Next obsolete" po-next-obsolete-entry + :help "Jump to next obsolete entry"] + ["Next untranslated" po-next-untranslated-entry + :help "Jump to next untranslated entry"] + ["Last file entry" po-last-entry + :help "Jump to last entry"] + "---" + ;; Backward + ["Any previous" po-previous-entry + :help "Jump to previous entry"] + ["Previous translated" po-previous-translated-entry + :help "Jump to previous translated entry"] + ["Previous fuzzy" po-previous-fuzzy-entry + :help "Jump to previous fuzzy entry"] + ["Previous obsolete" po-previous-obsolete-entry + :help "Jump to previous obsolete entry"] + ["Previous untranslated" po-previous-untranslated-entry + :help "Jump to previous untranslated entry"] + ["First file entry" po-first-entry + :help "Jump to first entry"] + "---" + ;; "Position stack" + ["Mark and push current" po-push-location + :help "Remember current location"] + ["Pop and return" po-pop-location + :help "Jump to last remembered location and forget about it"] + ["Exchange current/top" po-exchange-location + :help "Jump to last remembered location and remember current location"] + "---" + ["Redisplay" po-current-entry + :help "Make current entry properly visible"] + ["Current index" po-statistics + :help "Statistical info on current translation file"]) + ("Modifying entries" + ["Undo" po-undo + :help "Revoke last changed entry"] + "---" + ;; "Msgstr" + ["Edit msgstr" po-edit-msgstr + :help "Edit current translation"] + ["Ediff and merge msgstr" po-edit-msgstr-and-ediff + :help "Call `ediff' on current translation for merging"] + ["Cut msgstr" po-kill-msgstr + :help "Cut (kill) current translation"] + ["Copy msgstr" po-kill-ring-save-msgstr + :help "Copy current translation"] + ["Paste msgstr" po-yank-msgstr + :help "Paste (yank) text most recently cut/copied translation"] + "---" + ;; "Comments" + ["Edit comment" po-edit-comment + :help "Edit current comment"] + ["Ediff and merge comment" po-edit-comment-and-ediff + :help "Call `ediff' on current comment for merging"] + ["Cut comment" po-kill-comment + :help "Cut (kill) current comment"] + ["Copy comment" po-kill-ring-save-comment + :help "Copy current translation"] + ["Paste comment" po-yank-comment + :help "Paste (yank) text most recently cut/copied"] + "---" + ["Remove fuzzy mark" po-unfuzzy + :help "Remove \"#, fuzzy\""] + ["Fuzzy or fade out" po-fade-out-entry + :help "Set current entry fuzzy, or if already fuzzy delete it"] + ["Init with msgid" po-msgid-to-msgstr + :help "Initialize or replace current translation with the original message"]) + ("Other files" + ["Other window" po-other-window + :help "Select other window; if necessay split current frame"] + "---" + ;; "Program sources" + ["Cycle reference in source file" 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 add entry to compendium" po-save-entry nil] + ;; ["Select from compendium, save" po-select-and-save-entry nil] + "---" + ;; "Auxiliary files" + ["Cycle through auxilicary file" po-cycle-auxiliary t] + ["Select auxilicary file" po-select-auxiliary t] + ["Consider as auxilicary file" po-consider-as-auxiliary t] + ["Ignore as auxilicary 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 + :help "Display version number of PO mode"] + ["Help page" po-help + :help "Show the PO mode help screen"] + ["Validate" po-validate + :help "Check validity of current translation file using `msgfmt'"] + ["Mail officially" po-send-mail + :help "Send current translation file to the Translation Robot by mail"] + ["Edit out full" po-edit-out-full + :help "Leave PO mode to edit translation file using fundamental mode"] + "---" + ["Forceful quit" po-quit + :help "Close (kill) current translation file without saving"] + ["Soft quit" po-confirm-and-quit + :help "Save current translation file, than close (kill) it"])) + + +(defconst po-subedit-mode-menu-layout + `("PO-Edit" + ["Ediff and merge translation variants" po-subedit-ediff + :help "Call `ediff' for merging variants"] + ["Cycle through auxiliary files" po-subedit-cycle-auxiliary t] + "---" + ["Abort edit" po-subedit-abort + :help "Don't change the translation"] + ["Exit edit" po-subedit-exit + :help "Use this text as the translation and close current edit buffer"])) + +(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-previous-msgctxt-regexp + "^#\\(~\\)?|[ \t]*msgctxt.*\n\\(#\\(~\\)?|[ \t]*\".*\n\\)*" + "Regexp matching a whole #| msgctxt field, whether obsolete or not.") + +(defvar po-any-previous-msgid-regexp + "^#\\(~\\)?|[ \t]*msgid.*\n\\(#\\(~\\)?|[ \t]*\".*\n\\)*" + "Regexp matching a whole #| msgid field, whether obsolete or not.") + +(defvar po-any-previous-msgid_plural-regexp + "^#\\(~\\)?|[ \t]*msgid_plural.*\n\\(#\\(~\\)?|[ \t]*\".*\n\\)*" + "Regexp matching a whole #| msgid_plural field, whether obsolete or not.") + +(defvar po-any-msgctxt-msgid-regexp + "^\\(#~[ \t]*\\)?msg\\(ctxt\\|id\\).*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" + "Regexp matching a whole msgctxt or msgid field, whether obsolete or not.") + +(defvar po-any-msgid-regexp + "^\\(#~[ \t]*\\)?msgid.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" + "Regexp matching a whole msgid field, whether obsolete or not.") + +(defvar po-any-msgid_plural-regexp + "^\\(#~[ \t]*\\)?msgid_plural.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" + "Regexp matching a whole msgid_plural field, whether obsolete or not.") + +(defvar po-any-msgstr-block-regexp + "^\\(#~[ \t]*\\)?msgstr\\([ \t]\\|\\[0\\]\\).*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*\\(\\(#~[ \t]*\\)?msgstr\\[[0-9]\\].*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*\\)*" + "Regexp matching a whole msgstr or msgstr[] field, whether obsolete or not.") + +(defvar po-any-msgstr-form-regexp + ;; "^\\(#~[ \t]*\\)?msgstr.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" + "^\\(#~[ \t]*\\)?msgstr\\(\\[[0-9]\\]\\)?.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" + "Regexp matching just one 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 + '( + ("^# .*\\|^#[:,]?" . font-lock-comment-face) + ("^#:\\(.*\\)" 1 font-lock-reference-face) + ("^#,\\(.*\\)" 1 font-lock-function-name-face) + ("^\\(\\(msg\\(ctxt\\|id\\(_plural\\)?\\|str\\(\\[[0-9]\\]\\)?\\)\\) \\)?\"\\|\"$" + . font-lock-keyword-face) + ("\\\\.\\|%[*$-.0-9hjltuzL]*[a-zA-Z]" . font-lock-variable-name-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 "\C-_" 'po-undo) + (define-key po-mode-map "\C-xu" '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.") + +;;;###autoload +(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) + (easy-menu-define po-mode-menu po-mode-map "" po-mode-menu-layout)) + (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-msgctxt) + (make-local-variable 'po-start-of-msgid) + (make-local-variable 'po-start-of-msgid_plural) + (make-local-variable 'po-start-of-msgstr-block) + (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-block) + (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) "") + (goto-char po-end-of-entry)) + (if (re-search-forward "^msgid" (point-max) t) + (progn + ;; Start counting + (while (re-search-forward po-any-msgstr-block-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. +Can be customized with the `po-auto-update-file-header' variable." + (if (or (eq po-auto-update-file-header t) + (and (eq po-auto-update-file-header 'ask) + (y-or-n-p (_"May I update the PO Header Entry? ")))) + (save-excursion + (save-restriction + (widen) ; in case of a narrowed view to the buffer + (let ((buffer-read-only po-read-only) + insert-flag end-of-header) + (goto-char (point-min)) + (if (re-search-forward po-any-msgstr-block-regexp nil t) + (progn + ;; There is at least one entry. + (goto-char (match-beginning 0)) + (forward-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)) + (forward-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"))))))) + (message (_"PO Header Entry was not updated...")))) + +(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..."))) + ;; Return nil to indicate that the buffer has not yet been saved. + nil) + +;;; 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-msgctxt, po-start-of-msgid, +po-start-of-msgid_plural, po-start-of-msgstr-block, po-end-of-entry, and +po-entry-type to meaningful values. po-entry-type may be set to: obsolete, +fuzzy, untranslated, or translated." + (let ((here (point))) + (if (re-search-backward po-any-msgstr-block-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-block-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-block (match-beginning 0) + po-end-of-entry (match-end 0)) + (if (re-search-forward po-any-msgstr-block-regexp nil t) + (progn + ;; We definitely were not in the crumb. + (setq po-start-of-msgstr-block (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-block) + (setq po-start-of-entry + (if (re-search-backward po-any-msgstr-block-regexp nil t) + (match-end 0) + (point-min))))) + ;; The cursor was inside msgstr of the current entry. + (setq po-start-of-msgstr-block (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-block) + (setq po-start-of-entry + (if (re-search-backward po-any-msgstr-block-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-block-regexp) + (setq po-start-of-msgstr-block (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-msgctxt-msgid-regexp) + (setq po-start-of-msgctxt (match-beginning 0)) + (goto-char po-start-of-entry) + (re-search-forward po-any-msgid-regexp) + (setq po-start-of-msgid (match-beginning 0)) + (save-excursion + (goto-char po-start-of-msgid) + (setq po-start-of-msgid_plural + (if (re-search-forward po-any-msgid_plural-regexp + po-start-of-msgstr-block t) + (match-beginning 0) + nil))) + (save-excursion + (when (>= here po-start-of-msgstr-block) + ;; point was somewhere inside of msgstr* + (goto-char here) + (end-of-line) + (re-search-backward "^\\(#~[ \t]*\\)?msgstr")) + ;; Detect the boundaries of the msgstr we are interested in. + (re-search-forward po-any-msgstr-form-regexp) + (setq po-start-of-msgstr-form (match-beginning 0) + po-end-of-msgstr-form (match-end 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-msgctxt t) + 'fuzzy + (goto-char po-start-of-msgstr-block) + (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-msgctxt 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) ?#) + (forward-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-msgctxt 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-block-regexp)) + +(defun po-last-entry () + "Display the last entry." + (interactive) + (po-last-entry-with-regexp po-any-msgstr-block-regexp)) + +(defun po-next-entry () + "Display the entry following the current entry." + (interactive) + (po-next-entry-with-regexp po-any-msgstr-block-regexp nil)) + +(defun po-previous-entry () + "Display the entry preceding the current entry." + (interactive) + (po-previous-entry-with-regexp po-any-msgstr-block-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\\(\\[[0-9]\\]\\)?[ \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) + (prog1 (y-or-n-p (_"Really lose previous translation? ")) + (message ""))) + ;; In an entry with plural forms, use the msgid_plural string, + ;; as it is more general than the msgid string. + (if (po-set-msgstr-form (or (po-get-msgid_plural) (po-get-msgid))) + (po-maybe-delete-previous-untranslated)))) + +;; 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-maybe-delete-previous-untranslated) + (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-block-regexp t) + (po-find-span-of-entry) + (while (not (eq po-entry-type 'translated)) + (po-next-entry-with-regexp po-any-msgstr-block-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-block-regexp t) + (po-find-span-of-entry) + (while (not (eq po-entry-type 'translated)) + (po-previous-entry-with-regexp po-any-msgstr-block-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-block-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 () + "Extract and return the unquoted msgid string." + (let ((string (po-extract-unquoted (current-buffer) + po-start-of-msgid + (or po-start-of-msgid_plural + po-start-of-msgstr-block)))) + string)) + +(defun po-get-msgid_plural () + "Extract and return the unquoted msgid_plural string. +Return nil if it is not present." + (if po-start-of-msgid_plural + (let ((string (po-extract-unquoted (current-buffer) + po-start-of-msgid_plural + po-start-of-msgstr-block))) + string) + nil)) + +(defun po-get-msgstr-flavor () + "Helper function to detect msgstr and msgstr[] variants. +Returns one of \"msgstr\" or \"msgstr[i]\" for some i." + (save-excursion + (goto-char po-start-of-msgstr-form) + (re-search-forward "^\\(#~[ \t]*\\)?\\(msgstr\\(\\[[0-9]\\]\\)?\\)") + (match-string 2))) + +(defun po-get-msgstr-form () + "Extract and return the unquoted msgstr string." + (let ((string (po-extract-unquoted (current-buffer) + po-start-of-msgstr-form + po-end-of-msgstr-form))) + 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-block) + (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 (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 + (po-get-msgstr-flavor) + (eq po-entry-type 'obsolete)))) + (save-excursion + (goto-char po-start-of-msgstr-form) + (re-search-forward po-any-msgstr-form-regexp po-end-of-msgstr-form) + (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 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) + (let ((string (po-get-msgstr-form))) + (po-kill-new string) + string)) + +(defun po-kill-msgstr () + "Empty the msgstr string from current entry, pushing it on the kill ring." + (interactive) + (po-kill-ring-save-msgstr) + (if (po-set-msgstr-form "") + (po-maybe-delete-previous-untranslated))) + +(defun po-yank-msgstr () + "Replace the current msgstr string by the top of the kill ring." + (interactive) + (po-find-span-of-entry) + (if (po-set-msgstr-form (if (eq last-command 'yank) '(yank-pop 1) '(yank))) + (po-maybe-delete-previous-untranslated)) + (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-block)) + (po-decrease-type-counter) + (po-update-mode-line-string) + ;; TODO: Should save all msgstr forms here, not just one. + (po-kill-new (po-get-msgstr-form)) + (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-block-regexp nil t) + (goto-char (match-beginning 0)) + (re-search-backward po-any-msgstr-block-regexp nil t)) + (po-current-entry) + (message "")))) + +;;; Killing and yanking comments. + +(defvar po-comment-regexp + "^\\(#\n\\|# .*\n\\)+" + "Regexp matching the whole editable comment part of an 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 po-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 "#\\(\n\\| \\)" "# ?")) + (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) "#" "# ")) + (search-forward "\n")) + (setq string (buffer-string))) + (goto-char po-start-of-entry) + (if (re-search-forward po-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)) + +;;; Deleting the "previous untranslated" comment. + +(defun po-previous-untranslated-region-for (rx) + "Return the list of previous untranslated regions (at most one) for the +given regular expression RX." + (save-excursion + (goto-char po-start-of-entry) + (if (re-search-forward rx po-start-of-msgctxt t) + (list (cons (copy-marker (match-beginning 0)) + (copy-marker (match-end 0)))) + nil))) + +(defun po-previous-untranslated-regions () + "Return the list of previous untranslated regions in the current entry." + (append (po-previous-untranslated-region-for po-any-previous-msgctxt-regexp) + (po-previous-untranslated-region-for po-any-previous-msgid-regexp) + (po-previous-untranslated-region-for po-any-previous-msgid_plural-regexp))) + +(defun po-delete-previous-untranslated () + "Delete the previous msgctxt, msgid, msgid_plural fields (marked as #| +comments) from the current entry." + (interactive) + (po-find-span-of-entry) + (let ((buffer-read-only po-read-only)) + (dolist (region (po-previous-untranslated-regions)) + (delete-region (car region) (cdr region)))) + (po-redisplay)) + +(defun po-maybe-delete-previous-untranslated () + "Delete the previous msgctxt, msgid, msgid_plural fields (marked as #| +comments) from the current entry, if the user gives the permission." + (po-find-span-of-entry) + (let ((previous-regions (po-previous-untranslated-regions))) + (if previous-regions + (if (or (eq po-auto-delete-previous-msgid t) + (and (eq po-auto-delete-previous-msgid 'ask) + (let ((overlays nil)) + (unwind-protect + (progn + (setq overlays + (mapcar (function + (lambda (region) + (let ((overlay (po-create-overlay))) + (po-highlight overlay (car region) (cdr region)) + overlay))) + previous-regions)) + ;; Scroll, to show the previous-regions. + (goto-char (car (car previous-regions))) + (prog1 (y-or-n-p (_"Delete previous msgid comments? ")) + (message ""))) + (mapc 'po-dehighlight overlays))))) + (let ((buffer-read-only po-read-only)) + (dolist (region previous-regions) + (delete-region (car region) (cdr region)))))))) + +;;; 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)) + (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)) + (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 (po-check-all-pending-edits) + ;; Don't ask the user for confirmation, since he has explicitly asked + ;; for it. + (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))) + +;; Avoid byte compiler warnings. +(defvar entry-buffer) + +(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-substring 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-form) + (if (po-set-msgstr-form string) + (progn + (po-maybe-delete-previous-untranslated) + (if (and 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-form))) + (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-block)) + ;; (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) + (text-mode) + (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) + (easy-menu-define po-subedit-mode-menu po-subedit-mode-map "" + po-subedit-mode-menu-layout)) + (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) + (po-get-msgstr-form)) + '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-block-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))) + ((eq field 'msgstr) (po-set-msgstr-form (po-get-msgstr-form)))) + (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")) + ;; FIXME: This cannot work: t and nil are not msgid and msgstr. + (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-block 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-block-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-block)) + (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-block)) + (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 keyword, +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 keyword? [%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 ((equal major-mode 'awk-mode) + '(po-find-awk-string . po-mark-awk-string)) + ((member major-mode '(c-mode c++-mode)) + '(po-find-c-string . po-mark-c-string)) + ((equal major-mode 'emacs-lisp-mode) + '(po-find-emacs-lisp-string . po-mark-emacs-lisp-string)) + ((equal major-mode 'python-mode) + '(po-find-python-string . po-mark-python-string)) + ((and (equal major-mode 'sh-mode) + (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) + ;; The 'compile' subsystem is autoloaded through a call to (compile ...). + ;; We need to initialize it outside of any binding. Without this statement, + ;; all defcustoms and defvars of compile.el would be undone when the let* + ;; terminates. + (require 'compile) + (let* ((dev-null + (cond ((boundp 'null-device) null-device) ; since Emacs 20.3 + ((memq system-type '(windows-nt windows-95)) "NUL") + (t "/dev/null"))) + (output + (if po-keep-mo-file + (concat (file-name-sans-extension buffer-file-name) ".mo") + dev-null)) + (compilation-buffer-name-function + (function (lambda (mode-name) + (concat "*" mode-name " validation*")))) + (compile-command (concat po-msgfmt-program + " --statistics -c -v -o " + (shell-quote-argument output) " " + (shell-quote-argument 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.19.5.1 or 0.11-pre1 or 0.16.2-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]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$") + (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)[-_A-Za-z0-9]+$") + (looking-at ".* \\([0-9]+\\)\\.\\([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-block-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-block-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 + (save-restriction + (narrow-to-region (point) (point)) + (insert-buffer-substring buffer) + (shell-command-on-region + (point-min) (point-max) + (concat po-gzip-uuencode-command " " name ".gz") t 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))))))) + +;;;###autoload (add-to-list 'auto-mode-alist '("\\.po[tx]?\\'\\|\\.po\\." . po-mode)) +;;;###autoload (modify-coding-system-alist 'file "\\.po[tx]?\\'\\|\\.po\\." 'po-find-file-coding-system) + +(provide 'po-mode) + +;; Hey Emacs! +;; Local Variables: +;; indent-tabs-mode: nil +;; coding: utf-8 +;; End: + +;;; po-mode.el ends here |