| ;;; 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 |