| 1 | ;;; po-mode.el --- major mode for GNU gettext PO files |
| 2 | |
| 3 | ;; Copyright (C) 1995-2002, 2005-2008, 2010, 2013-2017, 2019-2020 Free Software |
| 4 | ;; Foundation, Inc. |
| 5 | |
| 6 | ;; Authors: François Pinard <pinard@iro.umontreal.ca> |
| 7 | ;; Greg McGary <gkm@magilla.cichlid.com> |
| 8 | ;; Keywords: i18n gettext |
| 9 | ;; Created: 1995 |
| 10 | |
| 11 | ;; This file is part of GNU gettext. |
| 12 | |
| 13 | ;; This program is free software: you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation; either version 3 of the License, or |
| 16 | ;; (at your option) any later version. |
| 17 | |
| 18 | ;; This program is distributed in the hope that it will be useful, |
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 21 | ;; GNU General Public License for more details. |
| 22 | |
| 23 | ;; You should have received a copy of the GNU General Public License |
| 24 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; This package provides the tools meant to help editing PO files, |
| 29 | ;; as documented in the GNU gettext user's manual. See this manual |
| 30 | ;; for user documentation, which is not repeated here. |
| 31 | |
| 32 | ;; To install, merely put this file somewhere GNU Emacs will find it, |
| 33 | ;; then add the following lines to your .emacs file: |
| 34 | ;; |
| 35 | ;; (autoload 'po-mode "po-mode" |
| 36 | ;; "Major mode for translators to edit PO files" t) |
| 37 | ;; (setq auto-mode-alist (cons '("\\.po\\'\\|\\.po\\." . po-mode) |
| 38 | ;; auto-mode-alist)) |
| 39 | ;; |
| 40 | ;; To use the right coding system automatically under Emacs 20 or newer, |
| 41 | ;; also add: |
| 42 | ;; |
| 43 | ;; (autoload 'po-find-file-coding-system "po-compat") |
| 44 | ;; (modify-coding-system-alist 'file "\\.po\\'\\|\\.po\\." |
| 45 | ;; 'po-find-file-coding-system) |
| 46 | ;; |
| 47 | ;; You may also adjust some variables, below, by defining them in your |
| 48 | ;; '.emacs' file, either directly or through command 'M-x customize'. |
| 49 | |
| 50 | ;; TODO: |
| 51 | ;; Plural form editing: |
| 52 | ;; - When in edit mode, currently it highlights (in green) the msgid; |
| 53 | ;; it should also highlight the msgid_plural string, I would say, since |
| 54 | ;; the translator has to look at both. |
| 55 | ;; - After the translator finished the translation of msgstr[0], it would |
| 56 | ;; be nice if the cursor would automatically move to the beginning of the |
| 57 | ;; msgstr[1] line, so that the translator just needs to press RET to edit |
| 58 | ;; that. |
| 59 | ;; - If msgstr[1] is empty but msgstr[0] is not, it would be ergonomic if the |
| 60 | ;; contents of msgstr[0] would be copied. (Not sure if this should happen |
| 61 | ;; at the end of the editing msgstr[0] or at the beginning of the editing |
| 62 | ;; of msgstr[1].) Reason: These two strings are usually very similar. |
| 63 | |
| 64 | ;;; Code: |
| 65 | \f |
| 66 | (defconst po-mode-version-string "2.27" "\ |
| 67 | Version number of this version of po-mode.el.") |
| 68 | |
| 69 | ;;; Emacs portability matters - part I. |
| 70 | ;;; Here is the minimum for customization to work. See part II. |
| 71 | |
| 72 | ;; Experiment with Emacs LISP message internationalisation. |
| 73 | (eval-and-compile |
| 74 | (or (fboundp 'set-translation-domain) |
| 75 | (defsubst set-translation-domain (string) nil)) |
| 76 | (or (fboundp 'translate-string) |
| 77 | (defsubst translate-string (string) string))) |
| 78 | (defsubst _ (string) (translate-string string)) |
| 79 | (defsubst N_ (string) string) |
| 80 | |
| 81 | ;; Handle missing 'customs' package. |
| 82 | (eval-and-compile |
| 83 | (condition-case () |
| 84 | (require 'custom) |
| 85 | (error nil)) |
| 86 | (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) |
| 87 | nil |
| 88 | (defmacro defgroup (&rest args) |
| 89 | nil) |
| 90 | (defmacro defcustom (var value doc &rest args) |
| 91 | `(defvar ,var ,value ,doc)))) |
| 92 | \f |
| 93 | ;;; Customisation. |
| 94 | |
| 95 | (defgroup po nil |
| 96 | "Major mode for editing PO files" |
| 97 | :group 'i18n) |
| 98 | |
| 99 | (defcustom po-auto-edit-with-msgid nil |
| 100 | "*Automatically use msgid when editing untranslated entries." |
| 101 | :type 'boolean |
| 102 | :group 'po) |
| 103 | |
| 104 | (defcustom po-auto-fuzzy-on-edit nil |
| 105 | "*Automatically mark entries fuzzy when being edited." |
| 106 | :type 'boolean |
| 107 | :group 'po) |
| 108 | |
| 109 | (defcustom po-auto-delete-previous-msgid t |
| 110 | "*Automatically delete previous msgid (marked #|) when editing entry. |
| 111 | Value is nil, t, or ask." |
| 112 | :type '(choice (const nil) |
| 113 | (const t) |
| 114 | (const ask)) |
| 115 | :group 'po) |
| 116 | |
| 117 | (defcustom po-auto-select-on-unfuzzy nil |
| 118 | "*Automatically select some new entry while making an entry not fuzzy." |
| 119 | :type 'boolean |
| 120 | :group 'po) |
| 121 | |
| 122 | (defcustom po-keep-mo-file nil |
| 123 | "*Set whether MO file should be kept or discarded after validation." |
| 124 | :type 'boolean |
| 125 | :group 'po) |
| 126 | |
| 127 | (defcustom po-auto-update-file-header t |
| 128 | "*Automatically revise headers. Value is nil, t, or ask." |
| 129 | :type '(choice (const nil) |
| 130 | (const t) |
| 131 | (const ask)) |
| 132 | :group 'po) |
| 133 | |
| 134 | (defcustom po-auto-replace-revision-date t |
| 135 | "*Automatically revise date in headers. Value is nil, t, or ask." |
| 136 | :type '(choice (const nil) |
| 137 | (const t) |
| 138 | (const ask)) |
| 139 | :group 'po) |
| 140 | |
| 141 | (defcustom po-default-file-header "\ |
| 142 | # SOME DESCRIPTIVE TITLE. |
| 143 | # Copyright (C) YEAR Free Software Foundation, Inc. |
| 144 | # FIRST AUTHOR <EMAIL@ADDRESS>, YEAR. |
| 145 | # |
| 146 | #, fuzzy |
| 147 | msgid \"\" |
| 148 | msgstr \"\" |
| 149 | \"Project-Id-Version: PACKAGE VERSION\\n\" |
| 150 | \"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n\" |
| 151 | \"Last-Translator: FULL NAME <EMAIL@ADDRESS>\\n\" |
| 152 | \"Language-Team: LANGUAGE <LL@li.org>\\n\" |
| 153 | \"MIME-Version: 1.0\\n\" |
| 154 | \"Content-Type: text/plain; charset=CHARSET\\n\" |
| 155 | \"Content-Transfer-Encoding: 8bit\\n\" |
| 156 | " |
| 157 | "*Default PO file header." |
| 158 | :type 'string |
| 159 | :group 'po) |
| 160 | |
| 161 | (defcustom po-translation-project-address |
| 162 | "robot@translationproject.org" |
| 163 | "*Electronic mail address of the Translation Project. |
| 164 | Typing \\[po-send-mail] (normally bound to `M') the user will send the PO file |
| 165 | to this email address." |
| 166 | :type 'string |
| 167 | :group 'po) |
| 168 | |
| 169 | (defcustom po-translation-project-mail-label "TP-Robot" |
| 170 | "*Subject label when sending the PO file to `po-translation-project-address'." |
| 171 | :type 'string |
| 172 | :group 'po) |
| 173 | |
| 174 | (defcustom po-highlighting t |
| 175 | "*Highlight text whenever appropriate, when non-nil. |
| 176 | However, on older Emacses, a yet unexplained highlighting bug causes files |
| 177 | to get mangled." |
| 178 | :type 'boolean |
| 179 | :group 'po) |
| 180 | |
| 181 | (defcustom po-highlight-face 'highlight |
| 182 | "*The face used for PO mode highlighting. For Emacses with overlays. |
| 183 | Possible values are 'highlight', 'modeline', 'secondary-selection', |
| 184 | 'region', and 'underline'. |
| 185 | This variable can be set by the user to whatever face they desire. |
| 186 | It's most convenient if the cursor color and highlight color are |
| 187 | slightly different." |
| 188 | :type 'face |
| 189 | :group 'po) |
| 190 | |
| 191 | (defcustom po-team-name-to-code |
| 192 | ;; All possible languages, a complete ISO 639 list, the inverse of |
| 193 | ;; gettext-tools/src/lang-table.c, and a little more. |
| 194 | '(("LANGUAGE" . "LL") |
| 195 | ("(Afan) Oromo" . "om") |
| 196 | ("Abkhazian" . "ab") |
| 197 | ("Achinese" . "ace") |
| 198 | ("Afar" . "aa") |
| 199 | ("Afrikaans" . "af") |
| 200 | ("Akan" . "ak") |
| 201 | ("Albanian" . "sq") |
| 202 | ("Amharic" . "am") |
| 203 | ("Arabic" . "ar") |
| 204 | ("Aragonese" . "an") |
| 205 | ("Argentinian" . "es_AR") |
| 206 | ("Armenian" . "hy") |
| 207 | ("Assamese" . "as") |
| 208 | ("Austrian" . "de_AT") |
| 209 | ("Avaric" . "av") |
| 210 | ("Avestan" . "ae") |
| 211 | ("Awadhi" . "awa") |
| 212 | ("Aymara" . "ay") |
| 213 | ("Azerbaijani" . "az") |
| 214 | ("Balinese" . "ban") |
| 215 | ("Baluchi" . "bal") |
| 216 | ("Bambara" . "bm") |
| 217 | ("Bashkir" . "ba") |
| 218 | ("Basque" . "eu") |
| 219 | ("Beja" . "bej") |
| 220 | ("Belarusian" . "be") |
| 221 | ("Bemba" . "bem") |
| 222 | ("Bengali" . "bn") |
| 223 | ("Bhojpuri" . "bho") |
| 224 | ("Bihari" . "bh") |
| 225 | ("Bikol" . "bik") |
| 226 | ("Bini" . "bin") |
| 227 | ("Bislama" . "bi") |
| 228 | ("Bosnian" . "bs") |
| 229 | ("Brazilian Portuguese" . "pt_BR") |
| 230 | ("Breton" . "br") |
| 231 | ("Buginese" . "bug") |
| 232 | ("Bulgarian" . "bg") |
| 233 | ("Burmese" . "my") |
| 234 | ("Catalan" . "ca") |
| 235 | ("Cebuano" . "ceb") |
| 236 | ("Central Khmer" . "km") |
| 237 | ("Chamorro" . "ch") |
| 238 | ("Chechen" . "ce") |
| 239 | ("Chinese" . "zh") |
| 240 | ("Chinese (Hong Kong)" . "zh_HK") |
| 241 | ("Chinese (simplified)" . "zh_CN") |
| 242 | ("Chinese (traditional)" . "zh_TW") |
| 243 | ("Church Slavic" . "cu") |
| 244 | ("Chuvash" . "cv") |
| 245 | ("Cornish" . "kw") |
| 246 | ("Corsican" . "co") |
| 247 | ("Cree" . "cr") |
| 248 | ("Croatian" . "hr") |
| 249 | ("Czech" . "cs") |
| 250 | ("Danish" . "da") |
| 251 | ("Dinka" . "din") |
| 252 | ("Divehi" . "dv") |
| 253 | ("Dogri" . "doi") |
| 254 | ("Dutch" . "nl") |
| 255 | ("Dzongkha" . "dz") |
| 256 | ("English" . "en") |
| 257 | ("English (British)" . "en_GB") |
| 258 | ("Esperanto" . "eo") |
| 259 | ("Estonian" . "et") |
| 260 | ("Ewe" . "ee") |
| 261 | ("Faroese" . "fo") |
| 262 | ("Fijian" . "fj") |
| 263 | ("Filipino" . "fil") |
| 264 | ("Finnish" . "fi") |
| 265 | ("Fon" . "fon") |
| 266 | ("French" . "fr") |
| 267 | ("Frisian" . "fy") |
| 268 | ("Fulah" . "ff") |
| 269 | ("Galician" . "gl") |
| 270 | ("Ganda" . "lg") |
| 271 | ("Georgian" . "ka") |
| 272 | ("German" . "de") |
| 273 | ("Gondi" . "gon") |
| 274 | ("Greek" . "el") |
| 275 | ("Guarani" . "gn") |
| 276 | ("Gujarati" . "gu") |
| 277 | ("Haitian" . "ht") |
| 278 | ("Hausa" . "ha") |
| 279 | ("Hebrew" . "he") |
| 280 | ("Herero" . "hz") |
| 281 | ("Hiligaynon" . "hil") |
| 282 | ("Hindi" . "hi") |
| 283 | ("Hiri Motu" . "ho") |
| 284 | ("Hmong" . "hmn") |
| 285 | ("Hungarian" . "hu") |
| 286 | ("Hyam" . "jab") |
| 287 | ("Icelandic" . "is") |
| 288 | ("Ido" . "io") |
| 289 | ("Igbo" . "ig") |
| 290 | ("Iloko" . "ilo") |
| 291 | ("Indonesian" . "id") |
| 292 | ("Interlingua" . "ia") |
| 293 | ("Interlingue" . "ie") |
| 294 | ("Inuktitut" . "iu") |
| 295 | ("Inupiak" . "ik") |
| 296 | ("Irish" . "ga") |
| 297 | ("Italian" . "it") |
| 298 | ("Japanese" . "ja") |
| 299 | ("Javanese" . "jv") |
| 300 | ("Jju" . "kaj") |
| 301 | ("Kabardian" . "kbd") |
| 302 | ("Kabyle" . "kab") |
| 303 | ("Kagoma" . "kdm") |
| 304 | ("Kalaallisut" . "kl") |
| 305 | ("Kamba" . "kam") |
| 306 | ("Kannada" . "kn") |
| 307 | ("Kanuri" . "kr") |
| 308 | ("Kashmiri" . "ks") |
| 309 | ("Kashubian" . "csb") |
| 310 | ("Kazakh" . "kk") |
| 311 | ("Khmer" . "km") ; old name |
| 312 | ("Kikuyu" . "ki") |
| 313 | ("Kimbundu" . "kmb") |
| 314 | ("Kinyarwanda" . "rw") |
| 315 | ("Kirghiz" . "ky") |
| 316 | ("Kirundi" . "rn") |
| 317 | ("Komi" . "kv") |
| 318 | ("Kongo" . "kg") |
| 319 | ("Konkani" . "kok") |
| 320 | ("Korean" . "ko") |
| 321 | ("Kuanyama" . "kj") |
| 322 | ("Kurdish" . "ku") |
| 323 | ("Kurukh" . "kru") |
| 324 | ("Laotian" . "lo") |
| 325 | ("Latin" . "la") |
| 326 | ("Latvian" . "lv") |
| 327 | ("Letzeburgesch" . "lb") |
| 328 | ("Limburgish" . "li") |
| 329 | ("Lingala" . "ln") |
| 330 | ("Lithuanian" . "lt") |
| 331 | ("Low Saxon" . "nds") |
| 332 | ("Luba-Katanga" . "lu") |
| 333 | ("Luba-Lulua" . "lua") |
| 334 | ("Luo" . "luo") |
| 335 | ("Macedonian" . "mk") |
| 336 | ("Madurese" . "mad") |
| 337 | ("Magahi" . "mag") |
| 338 | ("Maithili" . "mai") |
| 339 | ("Makasar" . "mak") |
| 340 | ("Malagasy" . "mg") |
| 341 | ("Malay" . "ms") |
| 342 | ("Malayalam" . "ml") |
| 343 | ("Maltese" . "mt") |
| 344 | ("Mandingo" . "man") |
| 345 | ("Manipuri" . "mni") |
| 346 | ("Manx" . "gv") |
| 347 | ("Maori" . "mi") |
| 348 | ("Marathi" . "mr") |
| 349 | ("Marshall" . "mh") |
| 350 | ("Marshallese" . "mh") |
| 351 | ("Marwari" . "mwr") |
| 352 | ("Mayan" . "myn") |
| 353 | ("Mende" . "men") |
| 354 | ("Minangkabau" . "min") |
| 355 | ("Moldavian" . "mo") |
| 356 | ("Mongolian" . "mn") |
| 357 | ("Mossi" . "mos") |
| 358 | ("Nahuatl" . "nah") |
| 359 | ("Nauru" . "na") |
| 360 | ("Navajo" . "nv") |
| 361 | ("Ndonga" . "ng") |
| 362 | ("Neapolitan" . "nap") |
| 363 | ("Nepali" . "ne") |
| 364 | ("North Ndebele" . "nd") |
| 365 | ("Northern Sami" . "se") |
| 366 | ("Northern Sotho" . "nso") |
| 367 | ("Norwegian Bokmal" . "nb") |
| 368 | ("Norwegian Nynorsk" . "nn") |
| 369 | ("Norwegian" . "no") |
| 370 | ("Nyamwezi" . "nym") |
| 371 | ("Nyanja" . "ny") |
| 372 | ("Nyankole" . "nyn") |
| 373 | ("Occitan" . "oc") |
| 374 | ("Ojibwa" . "oj") |
| 375 | ("Old English" . "ang") |
| 376 | ("Oriya" . "or") |
| 377 | ("Ossetian" . "os") |
| 378 | ("Páez" . "pbb") |
| 379 | ("Pali" . "pi") |
| 380 | ("Pampanga" . "pam") |
| 381 | ("Pangasinan" . "pag") |
| 382 | ("Pashto" . "ps") |
| 383 | ("Persian" . "fa") |
| 384 | ("Polish" . "pl") |
| 385 | ("Portuguese" . "pt") |
| 386 | ("Punjabi" . "pa") |
| 387 | ("Quechua" . "qu") |
| 388 | ("Rajasthani" . "raj") |
| 389 | ("Rhaeto-Roman" . "rm") ; old name |
| 390 | ("Romanian" . "ro") |
| 391 | ("Romansh" . "rm") |
| 392 | ("Russian" . "ru") |
| 393 | ("Samoan" . "sm") |
| 394 | ("Sango" . "sg") |
| 395 | ("Sanskrit" . "sa") |
| 396 | ("Santali" . "sat") |
| 397 | ("Sardinian" . "sc") |
| 398 | ("Sasak" . "sas") |
| 399 | ("Scots" . "gd") ; old name |
| 400 | ("Scottish Gaelic" . "gd") |
| 401 | ("Serbian" . "sr") |
| 402 | ("Serer" . "srr") |
| 403 | ("Sesotho" . "st") |
| 404 | ("Setswana" . "tn") |
| 405 | ("Shan" . "shn") |
| 406 | ("Shona" . "sn") |
| 407 | ("Sichuan Yi" . "ii") |
| 408 | ("Sicilian" . "scn") |
| 409 | ("Sidamo" . "sid") |
| 410 | ("Sindhi" . "sd") |
| 411 | ("Sinhala" . "si") |
| 412 | ("Sinhalese" . "si") |
| 413 | ("Siswati" . "ss") |
| 414 | ("Slovak" . "sk") |
| 415 | ("Slovenian" . "sl") |
| 416 | ("Somali" . "so") |
| 417 | ("Sorbian" . "wen") |
| 418 | ("South Ndebele" . "nr") |
| 419 | ("Spanish" . "es") |
| 420 | ("Spanish (Canary Islands)" . "es_IC") |
| 421 | ("Sukuma" . "suk") |
| 422 | ("Sundanese" . "su") |
| 423 | ("Susu" . "sus") |
| 424 | ("Swahili" . "sw") |
| 425 | ("Swedish" . "sv") |
| 426 | ("Swiss German" . "gsw") |
| 427 | ("Tagalog" . "tl") |
| 428 | ("Tahitian" . "ty") |
| 429 | ("Tajik" . "tg") |
| 430 | ("Tamil" . "ta") |
| 431 | ("Tatar" . "tt") |
| 432 | ("Telugu" . "te") |
| 433 | ("Tetum" . "tet") |
| 434 | ("Thai" . "th") |
| 435 | ("Tibetan" . "bo") |
| 436 | ("Tigrinya" . "ti") |
| 437 | ("Timne" . "tem") |
| 438 | ("Tiv" . "tiv") |
| 439 | ("Tonga" . "to") |
| 440 | ("Tsonga" . "ts") |
| 441 | ("Tumbuka" . "tum") |
| 442 | ("Turkish" . "tr") |
| 443 | ("Turkmen" . "tk") |
| 444 | ("Twi" . "tw") |
| 445 | ("Tyap" . "kcg") |
| 446 | ("Uighur" . "ug") |
| 447 | ("Ukrainian" . "uk") |
| 448 | ("Umbundu" . "umb") |
| 449 | ("Urdu" . "ur") |
| 450 | ("Uzbek" . "uz") |
| 451 | ("Venda" . "ve") |
| 452 | ("Vietnamese" . "vi") |
| 453 | ("Volapuk" . "vo") |
| 454 | ("Walloon" . "wa") |
| 455 | ("Walamo" . "wal") |
| 456 | ("Waray" . "war") |
| 457 | ("Welsh" . "cy") |
| 458 | ("Western Frisian" . "fy") |
| 459 | ("Wolof" . "wo") |
| 460 | ("Xhosa" . "xh") |
| 461 | ("Yao" . "yao") |
| 462 | ("Yiddish" . "yi") |
| 463 | ("Yoruba" . "yo") |
| 464 | ("Zapotec" . "zap") |
| 465 | ("Zhuang" . "za") |
| 466 | ("Zulu" . "zu") |
| 467 | ) |
| 468 | "*Association list giving team codes from team names. |
| 469 | This is used for generating a submission file name for the 'M' command. |
| 470 | If a string instead of an alist, it is a team code to use unconditionnally." |
| 471 | :type 'sexp |
| 472 | :group 'po) |
| 473 | |
| 474 | (defcustom po-gzip-uuencode-command "gzip -9 | uuencode -m" |
| 475 | "*The filter to use for preparing a mail invoice of the PO file. |
| 476 | Normally \"gzip -9 | uuencode -m\", remove the -9 for lesser compression, |
| 477 | or remove the -m if you are not using the GNU version of 'uuencode'." |
| 478 | :type 'string |
| 479 | :group 'po) |
| 480 | |
| 481 | (defvar po-subedit-mode-syntax-table |
| 482 | (copy-syntax-table text-mode-syntax-table) |
| 483 | "Syntax table used while in PO mode.") |
| 484 | \f |
| 485 | ;;; Emacs portability matters - part II. |
| 486 | |
| 487 | ;;; Many portability matters are addressed in this page. The few remaining |
| 488 | ;;; cases, elsewhere, all involve 'eval-and-compile', 'boundp' or 'fboundp'. |
| 489 | |
| 490 | ;; Protect string comparisons from text properties if possible. |
| 491 | (eval-and-compile |
| 492 | (fset 'po-buffer-substring |
| 493 | (symbol-function (if (fboundp 'buffer-substring-no-properties) |
| 494 | 'buffer-substring-no-properties |
| 495 | 'buffer-substring))) |
| 496 | |
| 497 | (if (fboundp 'match-string-no-properties) |
| 498 | (fset 'po-match-string (symbol-function 'match-string-no-properties)) |
| 499 | (defun po-match-string (number) |
| 500 | "Return string of text matched by last search." |
| 501 | (po-buffer-substring (match-beginning number) (match-end number))))) |
| 502 | |
| 503 | ;; Handle missing 'with-temp-buffer' function. |
| 504 | (eval-and-compile |
| 505 | (if (fboundp 'with-temp-buffer) |
| 506 | (fset 'po-with-temp-buffer (symbol-function 'with-temp-buffer)) |
| 507 | |
| 508 | (defmacro po-with-temp-buffer (&rest forms) |
| 509 | "Create a temporary buffer, and evaluate FORMS there like 'progn'." |
| 510 | (let ((curr-buffer (make-symbol "curr-buffer")) |
| 511 | (temp-buffer (make-symbol "temp-buffer"))) |
| 512 | `(let ((,curr-buffer (current-buffer)) |
| 513 | (,temp-buffer (get-buffer-create |
| 514 | (generate-new-buffer-name " *po-temp*")))) |
| 515 | (unwind-protect |
| 516 | (progn |
| 517 | (set-buffer ,temp-buffer) |
| 518 | ,@forms) |
| 519 | (set-buffer ,curr-buffer) |
| 520 | (and (buffer-name ,temp-buffer) |
| 521 | (kill-buffer ,temp-buffer)))))))) |
| 522 | |
| 523 | ;; Handle missing 'kill-new' function. |
| 524 | (eval-and-compile |
| 525 | (if (fboundp 'kill-new) |
| 526 | (fset 'po-kill-new (symbol-function 'kill-new)) |
| 527 | |
| 528 | (defun po-kill-new (string) |
| 529 | "Push STRING onto the kill ring, for Emacs 18 where kill-new is missing." |
| 530 | (po-with-temp-buffer |
| 531 | (insert string) |
| 532 | (kill-region (point-min) (point-max)))))) |
| 533 | |
| 534 | ;; Handle missing 'read-event' function. |
| 535 | (eval-and-compile |
| 536 | (fset 'po-read-event |
| 537 | (cond ((fboundp 'read-event) |
| 538 | ;; GNU Emacs. |
| 539 | 'read-event) |
| 540 | (t |
| 541 | ;; Older Emacses. |
| 542 | 'read-char)))) |
| 543 | |
| 544 | ;; Handle missing 'force-mode-line-update' function. |
| 545 | (eval-and-compile |
| 546 | (if (fboundp 'force-mode-line-update) |
| 547 | (fset 'po-force-mode-line-update |
| 548 | (symbol-function 'force-mode-line-update)) |
| 549 | |
| 550 | (defun po-force-mode-line-update () |
| 551 | "Force the mode-line of the current buffer to be redisplayed." |
| 552 | (set-buffer-modified-p (buffer-modified-p))))) |
| 553 | |
| 554 | ;; Handle portable highlighting. Code has been adapted (OK... stolen! :-) |
| 555 | ;; from 'ispell.el'. |
| 556 | |
| 557 | (defun po-create-overlay () |
| 558 | "Create and return a deleted overlay structure. |
| 559 | The variable 'po-highlight-face' selects the face to use for highlighting." |
| 560 | (let ((overlay (make-overlay (point) (point)))) |
| 561 | (overlay-put overlay 'face po-highlight-face) |
| 562 | ;; The fun thing is that a deleted overlay retains its face, and is |
| 563 | ;; movable. |
| 564 | (delete-overlay overlay) |
| 565 | overlay)) |
| 566 | |
| 567 | (defun po-highlight (overlay start end &optional buffer) |
| 568 | "Use OVERLAY to highlight the string from START to END. |
| 569 | If limits are not relative to the current buffer, use optional BUFFER." |
| 570 | (move-overlay overlay start end (or buffer (current-buffer)))) |
| 571 | |
| 572 | (defun po-dehighlight (overlay) |
| 573 | "Display normally the last string which OVERLAY highlighted. |
| 574 | The current buffer should be in PO mode, when this function is called." |
| 575 | (delete-overlay overlay)) |
| 576 | |
| 577 | ;;; Buffer local variables. |
| 578 | |
| 579 | ;; The following block of declarations has the main purpose of avoiding |
| 580 | ;; byte compiler warnings. It also introduces some documentation for |
| 581 | ;; each of these variables, all meant to be local to PO mode buffers. |
| 582 | |
| 583 | ;; Flag telling that MODE-LINE-STRING should be displayed. See 'Window' |
| 584 | ;; page below. Exceptionally, this variable is local to *all* buffers. |
| 585 | (defvar po-mode-flag) |
| 586 | |
| 587 | ;; PO buffers are kept read-only to prevent random modifications. READ-ONLY |
| 588 | ;; holds the value of the read-only flag before PO mode was entered. |
| 589 | (defvar po-read-only) |
| 590 | |
| 591 | ;; The current entry extends from START-OF-ENTRY to END-OF-ENTRY, it |
| 592 | ;; includes preceding whitespace and excludes following whitespace. The |
| 593 | ;; start of keyword lines are START-OF-MSGID and START-OF-MSGSTR. |
| 594 | ;; ENTRY-TYPE classifies the entry. |
| 595 | (defvar po-start-of-entry) |
| 596 | (defvar po-start-of-msgctxt) ; = po-start-of-msgid if there is no msgctxt |
| 597 | (defvar po-start-of-msgid) |
| 598 | (defvar po-start-of-msgid_plural) ; = nil if there is no msgid_plural |
| 599 | (defvar po-start-of-msgstr-block) |
| 600 | (defvar po-start-of-msgstr-form) |
| 601 | (defvar po-end-of-msgstr-form) |
| 602 | (defvar po-end-of-entry) |
| 603 | (defvar po-entry-type) |
| 604 | |
| 605 | ;; A few counters are usefully shown in the Emacs mode line. |
| 606 | (defvar po-translated-counter) |
| 607 | (defvar po-fuzzy-counter) |
| 608 | (defvar po-untranslated-counter) |
| 609 | (defvar po-obsolete-counter) |
| 610 | (defvar po-mode-line-string) |
| 611 | |
| 612 | ;; PO mode keeps track of fields being edited, for one given field should |
| 613 | ;; have one editing buffer at most, and for exiting a PO buffer properly |
| 614 | ;; should offer to close all pending edits. Variable EDITED-FIELDS holds an |
| 615 | ;; an list of "slots" of the form: (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO). |
| 616 | ;; To allow simultaneous edition of the comment and the msgstr of an entry, |
| 617 | ;; ENTRY-MARKER points to the msgid line if a comment is being edited, or to |
| 618 | ;; the msgstr line if the msgstr is being edited. EDIT-BUFFER is the |
| 619 | ;; temporary Emacs buffer used to edit the string. OVERLAY-INFO, when not |
| 620 | ;; nil, holds an overlay (or if overlays are not supported, a cons of two |
| 621 | ;; markers) for this msgid string which became highlighted for the edit. |
| 622 | (defvar po-edited-fields) |
| 623 | |
| 624 | ;; We maintain a set of movable pointers for returning to entries. |
| 625 | (defvar po-marker-stack) |
| 626 | |
| 627 | ;; SEARCH path contains a list of directories where files may be found, |
| 628 | ;; in a format suitable for read completion. Each directory includes |
| 629 | ;; its trailing slash. PO mode starts with "./" and "../". |
| 630 | (defvar po-search-path) |
| 631 | |
| 632 | ;; The following variables are meaningful only when REFERENCE-CHECK |
| 633 | ;; is identical to START-OF-ENTRY, else they should be recomputed. |
| 634 | ;; REFERENCE-ALIST contains all known references for the current |
| 635 | ;; entry, each list element is (PROMPT FILE LINE), where PROMPT may |
| 636 | ;; be used for completing read, FILE is a string and LINE is a number. |
| 637 | ;; REFERENCE-CURSOR is a cycling cursor into REFERENCE-ALIST. |
| 638 | (defvar po-reference-alist) |
| 639 | (defvar po-reference-cursor) |
| 640 | (defvar po-reference-check) |
| 641 | |
| 642 | ;; The following variables are for marking translatable strings in program |
| 643 | ;; sources. KEYWORDS is the list of keywords for marking translatable |
| 644 | ;; strings, kept in a format suitable for reading with completion. |
| 645 | ;; STRING-CONTENTS holds the value of the most recent string found in sources, |
| 646 | ;; and when it is not nil, then STRING-BUFFER, STRING-START and STRING-END |
| 647 | ;; describe where it is. MARKING-OVERLAY, if not 'nil', holds the overlay |
| 648 | ;; which highlight the last found string; for older Emacses, it holds the cons |
| 649 | ;; of two markers around the highlighted region. |
| 650 | (defvar po-keywords) |
| 651 | (defvar po-string-contents) |
| 652 | (defvar po-string-buffer) |
| 653 | (defvar po-string-start) |
| 654 | (defvar po-string-end) |
| 655 | (defvar po-marking-overlay) |
| 656 | \f |
| 657 | ;;; PO mode variables and constants (usually not to customize). |
| 658 | |
| 659 | ;; The textdomain should really be "gettext", only trying it for now. |
| 660 | ;; All this requires more thinking, we cannot just do this like that. |
| 661 | (set-translation-domain "po-mode") |
| 662 | |
| 663 | (defun po-mode-version () |
| 664 | "Show Emacs PO mode version." |
| 665 | (interactive) |
| 666 | (message (_"Emacs PO mode, version %s") po-mode-version-string)) |
| 667 | |
| 668 | (defconst po-help-display-string |
| 669 | (_"\ |
| 670 | PO Mode Summary Next Previous Miscellaneous |
| 671 | *: Later, /: Docum n p Any type . Redisplay |
| 672 | t T Translated /v Version info |
| 673 | Moving around f F Fuzzy ?, h This help |
| 674 | < First if any o O Obsolete = Current index |
| 675 | > Last if any u U Untranslated 0 Other window |
| 676 | /SPC Auto select V Validate |
| 677 | Msgstr Comments M Mail officially |
| 678 | Modifying entries RET # Call editor _ Undo |
| 679 | TAB Remove fuzzy mark k K Kill to E Edit out full |
| 680 | DEL Fuzzy or fade out w W Copy to Q Forceful quit |
| 681 | LFD Init with msgid y Y Yank from q Confirm and quit |
| 682 | |
| 683 | gettext Keyword Marking Position Stack |
| 684 | , Find next string Compendiums m Mark and push current |
| 685 | M-, Mark translatable *c To compendium r Pop and return |
| 686 | M-. Change mark, mark *M-C Select, save x Exchange current/top |
| 687 | |
| 688 | Program Sources Auxiliary Files Lexicography |
| 689 | s Cycle reference a Cycle file *l Lookup translation |
| 690 | M-s Select reference C-c C-a Select file *M-l Add/edit translation |
| 691 | S Consider path A Consider PO file *L Consider lexicon |
| 692 | M-S Ignore path M-A Ignore PO file *M-L Ignore lexicon |
| 693 | ") |
| 694 | "Help page for PO mode.") |
| 695 | |
| 696 | (defconst po-mode-menu-layout |
| 697 | `("PO" |
| 698 | ("Moving around" |
| 699 | ["Auto select" po-auto-select-entry |
| 700 | :help "Jump to next interesting entry"] |
| 701 | "---" |
| 702 | ;; Forward |
| 703 | ["Any next" po-next-entry |
| 704 | :help "Jump to next entry"] |
| 705 | ["Next translated" po-next-translated-entry |
| 706 | :help "Jump to next translated entry"] |
| 707 | ["Next fuzzy" po-next-fuzzy-entry |
| 708 | :help "Jump to next fuzzy entry"] |
| 709 | ["Next obsolete" po-next-obsolete-entry |
| 710 | :help "Jump to next obsolete entry"] |
| 711 | ["Next untranslated" po-next-untranslated-entry |
| 712 | :help "Jump to next untranslated entry"] |
| 713 | ["Last file entry" po-last-entry |
| 714 | :help "Jump to last entry"] |
| 715 | "---" |
| 716 | ;; Backward |
| 717 | ["Any previous" po-previous-entry |
| 718 | :help "Jump to previous entry"] |
| 719 | ["Previous translated" po-previous-translated-entry |
| 720 | :help "Jump to previous translated entry"] |
| 721 | ["Previous fuzzy" po-previous-fuzzy-entry |
| 722 | :help "Jump to previous fuzzy entry"] |
| 723 | ["Previous obsolete" po-previous-obsolete-entry |
| 724 | :help "Jump to previous obsolete entry"] |
| 725 | ["Previous untranslated" po-previous-untranslated-entry |
| 726 | :help "Jump to previous untranslated entry"] |
| 727 | ["First file entry" po-first-entry |
| 728 | :help "Jump to first entry"] |
| 729 | "---" |
| 730 | ;; "Position stack" |
| 731 | ["Mark and push current" po-push-location |
| 732 | :help "Remember current location"] |
| 733 | ["Pop and return" po-pop-location |
| 734 | :help "Jump to last remembered location and forget about it"] |
| 735 | ["Exchange current/top" po-exchange-location |
| 736 | :help "Jump to last remembered location and remember current location"] |
| 737 | "---" |
| 738 | ["Redisplay" po-current-entry |
| 739 | :help "Make current entry properly visible"] |
| 740 | ["Current index" po-statistics |
| 741 | :help "Statistical info on current translation file"]) |
| 742 | ("Modifying entries" |
| 743 | ["Undo" po-undo |
| 744 | :help "Revoke last changed entry"] |
| 745 | "---" |
| 746 | ;; "Msgstr" |
| 747 | ["Edit msgstr" po-edit-msgstr |
| 748 | :help "Edit current translation"] |
| 749 | ["Ediff and merge msgstr" po-edit-msgstr-and-ediff |
| 750 | :help "Call `ediff' on current translation for merging"] |
| 751 | ["Cut msgstr" po-kill-msgstr |
| 752 | :help "Cut (kill) current translation"] |
| 753 | ["Copy msgstr" po-kill-ring-save-msgstr |
| 754 | :help "Copy current translation"] |
| 755 | ["Paste msgstr" po-yank-msgstr |
| 756 | :help "Paste (yank) text most recently cut/copied translation"] |
| 757 | "---" |
| 758 | ;; "Comments" |
| 759 | ["Edit comment" po-edit-comment |
| 760 | :help "Edit current comment"] |
| 761 | ["Ediff and merge comment" po-edit-comment-and-ediff |
| 762 | :help "Call `ediff' on current comment for merging"] |
| 763 | ["Cut comment" po-kill-comment |
| 764 | :help "Cut (kill) current comment"] |
| 765 | ["Copy comment" po-kill-ring-save-comment |
| 766 | :help "Copy current translation"] |
| 767 | ["Paste comment" po-yank-comment |
| 768 | :help "Paste (yank) text most recently cut/copied"] |
| 769 | "---" |
| 770 | ["Remove fuzzy mark" po-unfuzzy |
| 771 | :help "Remove \"#, fuzzy\""] |
| 772 | ["Fuzzy or fade out" po-fade-out-entry |
| 773 | :help "Set current entry fuzzy, or if already fuzzy delete it"] |
| 774 | ["Init with msgid" po-msgid-to-msgstr |
| 775 | :help "Initialize or replace current translation with the original message"]) |
| 776 | ("Other files" |
| 777 | ["Other window" po-other-window |
| 778 | :help "Select other window; if necessay split current frame"] |
| 779 | "---" |
| 780 | ;; "Program sources" |
| 781 | ["Cycle reference in source file" po-cycle-source-reference t] |
| 782 | ["Select reference" po-select-source-reference t] |
| 783 | ["Consider path" po-consider-source-path t] |
| 784 | ["Ignore path" po-ignore-source-path t] |
| 785 | ;; "---" |
| 786 | ;; ;; "Compendiums" |
| 787 | ;; ["To add entry to compendium" po-save-entry nil] |
| 788 | ;; ["Select from compendium, save" po-select-and-save-entry nil] |
| 789 | "---" |
| 790 | ;; "Auxiliary files" |
| 791 | ["Cycle through auxilicary file" po-cycle-auxiliary t] |
| 792 | ["Select auxilicary file" po-select-auxiliary t] |
| 793 | ["Consider as auxilicary file" po-consider-as-auxiliary t] |
| 794 | ["Ignore as auxilicary file" po-ignore-as-auxiliary t] |
| 795 | ;; "---" |
| 796 | ;; ;; "Lexicography" |
| 797 | ;; ["Lookup translation" po-lookup-lexicons nil] |
| 798 | ;; ["Add/edit translation" po-edit-lexicon-entry nil] |
| 799 | ;; ["Consider lexicon" po-consider-lexicon-file nil] |
| 800 | ;; ["Ignore lexicon" po-ignore-lexicon-file nil]) |
| 801 | "---" |
| 802 | "Source marking" |
| 803 | ["Find first string" (po-tags-search '(nil)) t] |
| 804 | ["Prefer keyword" (po-select-mark-and-mark '(nil)) t] |
| 805 | ["Find next string" po-tags-search t] |
| 806 | ["Mark preferred" po-mark-translatable t] |
| 807 | ["Mark with keyword" po-select-mark-and-mark t]) |
| 808 | "---" |
| 809 | ["Version info" po-mode-version |
| 810 | :help "Display version number of PO mode"] |
| 811 | ["Help page" po-help |
| 812 | :help "Show the PO mode help screen"] |
| 813 | ["Validate" po-validate |
| 814 | :help "Check validity of current translation file using `msgfmt'"] |
| 815 | ["Mail officially" po-send-mail |
| 816 | :help "Send current translation file to the Translation Robot by mail"] |
| 817 | ["Edit out full" po-edit-out-full |
| 818 | :help "Leave PO mode to edit translation file using fundamental mode"] |
| 819 | "---" |
| 820 | ["Forceful quit" po-quit |
| 821 | :help "Close (kill) current translation file without saving"] |
| 822 | ["Soft quit" po-confirm-and-quit |
| 823 | :help "Save current translation file, than close (kill) it"])) |
| 824 | |
| 825 | |
| 826 | (defconst po-subedit-mode-menu-layout |
| 827 | `("PO-Edit" |
| 828 | ["Ediff and merge translation variants" po-subedit-ediff |
| 829 | :help "Call `ediff' for merging variants"] |
| 830 | ["Cycle through auxiliary files" po-subedit-cycle-auxiliary t] |
| 831 | "---" |
| 832 | ["Abort edit" po-subedit-abort |
| 833 | :help "Don't change the translation"] |
| 834 | ["Exit edit" po-subedit-exit |
| 835 | :help "Use this text as the translation and close current edit buffer"])) |
| 836 | |
| 837 | (defconst po-subedit-message |
| 838 | (_"Type 'C-c C-c' once done, or 'C-c C-k' to abort edit") |
| 839 | "Message to post in the minibuffer when an edit buffer is displayed.") |
| 840 | |
| 841 | (defvar po-auxiliary-list nil |
| 842 | "List of auxiliary PO files, in completing read format.") |
| 843 | |
| 844 | (defvar po-auxiliary-cursor nil |
| 845 | "Cursor into the 'po-auxiliary-list'.") |
| 846 | |
| 847 | (defvar po-compose-mail-function |
| 848 | (let ((functions '(compose-mail-other-window |
| 849 | message-mail-other-window |
| 850 | compose-mail |
| 851 | message-mail)) |
| 852 | result) |
| 853 | (while (and (not result) functions) |
| 854 | (if (fboundp (car functions)) |
| 855 | (setq result (car functions)) |
| 856 | (setq functions (cdr functions)))) |
| 857 | (cond (result) |
| 858 | ((fboundp 'mail-other-window) |
| 859 | (function (lambda (to subject) |
| 860 | (mail-other-window nil to subject)))) |
| 861 | ((fboundp 'mail) |
| 862 | (function (lambda (to subject) |
| 863 | (mail nil to subject)))) |
| 864 | (t (function (lambda (to subject) |
| 865 | (error (_"I do not know how to mail to '%s'") to)))))) |
| 866 | "Function to start composing an electronic message.") |
| 867 | |
| 868 | (defvar po-any-previous-msgctxt-regexp |
| 869 | "^#\\(~\\)?|[ \t]*msgctxt.*\n\\(#\\(~\\)?|[ \t]*\".*\n\\)*" |
| 870 | "Regexp matching a whole #| msgctxt field, whether obsolete or not.") |
| 871 | |
| 872 | (defvar po-any-previous-msgid-regexp |
| 873 | "^#\\(~\\)?|[ \t]*msgid.*\n\\(#\\(~\\)?|[ \t]*\".*\n\\)*" |
| 874 | "Regexp matching a whole #| msgid field, whether obsolete or not.") |
| 875 | |
| 876 | (defvar po-any-previous-msgid_plural-regexp |
| 877 | "^#\\(~\\)?|[ \t]*msgid_plural.*\n\\(#\\(~\\)?|[ \t]*\".*\n\\)*" |
| 878 | "Regexp matching a whole #| msgid_plural field, whether obsolete or not.") |
| 879 | |
| 880 | (defvar po-any-msgctxt-msgid-regexp |
| 881 | "^\\(#~[ \t]*\\)?msg\\(ctxt\\|id\\).*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" |
| 882 | "Regexp matching a whole msgctxt or msgid field, whether obsolete or not.") |
| 883 | |
| 884 | (defvar po-any-msgid-regexp |
| 885 | "^\\(#~[ \t]*\\)?msgid.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" |
| 886 | "Regexp matching a whole msgid field, whether obsolete or not.") |
| 887 | |
| 888 | (defvar po-any-msgid_plural-regexp |
| 889 | "^\\(#~[ \t]*\\)?msgid_plural.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" |
| 890 | "Regexp matching a whole msgid_plural field, whether obsolete or not.") |
| 891 | |
| 892 | (defvar po-any-msgstr-block-regexp |
| 893 | "^\\(#~[ \t]*\\)?msgstr\\([ \t]\\|\\[0\\]\\).*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*\\(\\(#~[ \t]*\\)?msgstr\\[[0-9]\\].*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*\\)*" |
| 894 | "Regexp matching a whole msgstr or msgstr[] field, whether obsolete or not.") |
| 895 | |
| 896 | (defvar po-any-msgstr-form-regexp |
| 897 | ;; "^\\(#~[ \t]*\\)?msgstr.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" |
| 898 | "^\\(#~[ \t]*\\)?msgstr\\(\\[[0-9]\\]\\)?.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*" |
| 899 | "Regexp matching just one msgstr or msgstr[] field, whether obsolete or not.") |
| 900 | |
| 901 | (defvar po-msgstr-idx-keyword-regexp |
| 902 | "^\\(#~[ \t]*\\)?msgstr\\[[0-9]\\]" |
| 903 | "Regexp matching an indexed msgstr keyword, whether obsolete or not.") |
| 904 | |
| 905 | (defvar po-msgfmt-program "msgfmt" |
| 906 | "Path to msgfmt program from GNU gettext package.") |
| 907 | |
| 908 | ;; Font lock based highlighting code. |
| 909 | (defconst po-font-lock-keywords |
| 910 | '( |
| 911 | ("^# .*\\|^#[:,]?" . font-lock-comment-face) |
| 912 | ("^#:\\(.*\\)" 1 font-lock-reference-face) |
| 913 | ("^#,\\(.*\\)" 1 font-lock-function-name-face) |
| 914 | ("^\\(\\(msg\\(ctxt\\|id\\(_plural\\)?\\|str\\(\\[[0-9]\\]\\)?\\)\\) \\)?\"\\|\"$" |
| 915 | . font-lock-keyword-face) |
| 916 | ("\\\\.\\|%[*$-.0-9hjltuzL]*[a-zA-Z]" . font-lock-variable-name-face) |
| 917 | ) |
| 918 | "Additional expressions to highlight in PO mode.") |
| 919 | |
| 920 | ;; Old activator for 'font lock'. Is it still useful? I don't think so. |
| 921 | ;;(if (boundp 'font-lock-keywords) |
| 922 | ;; (put 'po-mode 'font-lock-keywords 'po-font-lock-keywords)) |
| 923 | |
| 924 | ;; 'hilit19' based highlighting code has been disabled, as most probably |
| 925 | ;; nobody really needs it (it also generates ugly byte-compiler warnings). |
| 926 | ;; |
| 927 | ;;(if (fboundp 'hilit-set-mode-patterns) |
| 928 | ;; (hilit-set-mode-patterns 'po-mode |
| 929 | ;; '(("^# .*\\|^#$" nil comment) |
| 930 | ;; ("^#[.,:].*" nil include) |
| 931 | ;; ("^\\(msgid\\|msgstr\\) *\"" nil keyword) |
| 932 | ;; ("^\"\\|\"$" nil keyword)))) |
| 933 | \f |
| 934 | ;;; Mode activation. |
| 935 | |
| 936 | ;; Emacs 21.2 comes with po-find-file-coding-system. We give preference |
| 937 | ;; to the version shipped with Emacs. |
| 938 | (if (not (fboundp 'po-find-file-coding-system)) |
| 939 | (require 'po-compat)) |
| 940 | |
| 941 | (defvar po-mode-abbrev-table nil |
| 942 | "Abbrev table used while in PO mode.") |
| 943 | (define-abbrev-table 'po-mode-abbrev-table ()) |
| 944 | |
| 945 | (defvar po-mode-map |
| 946 | ;; Use (make-keymap) because (make-sparse-keymap) does not work on Demacs. |
| 947 | (let ((po-mode-map (make-keymap))) |
| 948 | (suppress-keymap po-mode-map) |
| 949 | (define-key po-mode-map "\C-i" 'po-unfuzzy) |
| 950 | (define-key po-mode-map "\C-j" 'po-msgid-to-msgstr) |
| 951 | (define-key po-mode-map "\C-m" 'po-edit-msgstr) |
| 952 | (define-key po-mode-map " " 'po-auto-select-entry) |
| 953 | (define-key po-mode-map "?" 'po-help) |
| 954 | (define-key po-mode-map "#" 'po-edit-comment) |
| 955 | (define-key po-mode-map "," 'po-tags-search) |
| 956 | (define-key po-mode-map "." 'po-current-entry) |
| 957 | (define-key po-mode-map "<" 'po-first-entry) |
| 958 | (define-key po-mode-map "=" 'po-statistics) |
| 959 | (define-key po-mode-map ">" 'po-last-entry) |
| 960 | (define-key po-mode-map "a" 'po-cycle-auxiliary) |
| 961 | ;;;; (define-key po-mode-map "c" 'po-save-entry) |
| 962 | (define-key po-mode-map "f" 'po-next-fuzzy-entry) |
| 963 | (define-key po-mode-map "h" 'po-help) |
| 964 | (define-key po-mode-map "k" 'po-kill-msgstr) |
| 965 | ;;;; (define-key po-mode-map "l" 'po-lookup-lexicons) |
| 966 | (define-key po-mode-map "m" 'po-push-location) |
| 967 | (define-key po-mode-map "n" 'po-next-entry) |
| 968 | (define-key po-mode-map "o" 'po-next-obsolete-entry) |
| 969 | (define-key po-mode-map "p" 'po-previous-entry) |
| 970 | (define-key po-mode-map "q" 'po-confirm-and-quit) |
| 971 | (define-key po-mode-map "r" 'po-pop-location) |
| 972 | (define-key po-mode-map "s" 'po-cycle-source-reference) |
| 973 | (define-key po-mode-map "t" 'po-next-translated-entry) |
| 974 | (define-key po-mode-map "u" 'po-next-untranslated-entry) |
| 975 | (define-key po-mode-map "v" 'po-mode-version) |
| 976 | (define-key po-mode-map "w" 'po-kill-ring-save-msgstr) |
| 977 | (define-key po-mode-map "x" 'po-exchange-location) |
| 978 | (define-key po-mode-map "y" 'po-yank-msgstr) |
| 979 | (define-key po-mode-map "A" 'po-consider-as-auxiliary) |
| 980 | (define-key po-mode-map "E" 'po-edit-out-full) |
| 981 | (define-key po-mode-map "F" 'po-previous-fuzzy-entry) |
| 982 | (define-key po-mode-map "K" 'po-kill-comment) |
| 983 | ;;;; (define-key po-mode-map "L" 'po-consider-lexicon-file) |
| 984 | (define-key po-mode-map "M" 'po-send-mail) |
| 985 | (define-key po-mode-map "O" 'po-previous-obsolete-entry) |
| 986 | (define-key po-mode-map "T" 'po-previous-translated-entry) |
| 987 | (define-key po-mode-map "U" 'po-previous-untranslated-entry) |
| 988 | (define-key po-mode-map "Q" 'po-quit) |
| 989 | (define-key po-mode-map "S" 'po-consider-source-path) |
| 990 | (define-key po-mode-map "V" 'po-validate) |
| 991 | (define-key po-mode-map "W" 'po-kill-ring-save-comment) |
| 992 | (define-key po-mode-map "Y" 'po-yank-comment) |
| 993 | (define-key po-mode-map "_" 'po-undo) |
| 994 | (define-key po-mode-map "\C-_" 'po-undo) |
| 995 | (define-key po-mode-map "\C-xu" 'po-undo) |
| 996 | (define-key po-mode-map "0" 'po-other-window) |
| 997 | (define-key po-mode-map "\177" 'po-fade-out-entry) |
| 998 | (define-key po-mode-map "\C-c\C-a" 'po-select-auxiliary) |
| 999 | (define-key po-mode-map "\C-c\C-e" 'po-edit-msgstr-and-ediff) |
| 1000 | (define-key po-mode-map [?\C-c?\C-#] 'po-edit-comment-and-ediff) |
| 1001 | (define-key po-mode-map "\C-c\C-C" 'po-edit-comment-and-ediff) |
| 1002 | (define-key po-mode-map "\M-," 'po-mark-translatable) |
| 1003 | (define-key po-mode-map "\M-." 'po-select-mark-and-mark) |
| 1004 | ;;;; (define-key po-mode-map "\M-c" 'po-select-and-save-entry) |
| 1005 | ;;;; (define-key po-mode-map "\M-l" 'po-edit-lexicon-entry) |
| 1006 | (define-key po-mode-map "\M-s" 'po-select-source-reference) |
| 1007 | (define-key po-mode-map "\M-A" 'po-ignore-as-auxiliary) |
| 1008 | ;;;; (define-key po-mode-map "\M-L" 'po-ignore-lexicon-file) |
| 1009 | (define-key po-mode-map "\M-S" 'po-ignore-source-path) |
| 1010 | po-mode-map) |
| 1011 | "Keymap for PO mode.") |
| 1012 | |
| 1013 | ;;;###autoload |
| 1014 | (defun po-mode () |
| 1015 | "Major mode for translators when they edit PO files. |
| 1016 | |
| 1017 | Special commands: |
| 1018 | \\{po-mode-map} |
| 1019 | Turning on PO mode calls the value of the variable 'po-mode-hook', |
| 1020 | if that value is non-nil. Behaviour may be adjusted through some variables, |
| 1021 | all reachable through 'M-x customize', in group 'Emacs.Editing.I18n.Po'." |
| 1022 | (interactive) |
| 1023 | (kill-all-local-variables) |
| 1024 | (setq major-mode 'po-mode |
| 1025 | mode-name "PO") |
| 1026 | (use-local-map po-mode-map) |
| 1027 | (if (fboundp 'easy-menu-define) |
| 1028 | (easy-menu-define po-mode-menu po-mode-map "" po-mode-menu-layout)) |
| 1029 | (set (make-local-variable 'font-lock-defaults) '(po-font-lock-keywords t)) |
| 1030 | |
| 1031 | (set (make-local-variable 'po-read-only) buffer-read-only) |
| 1032 | (setq buffer-read-only t) |
| 1033 | |
| 1034 | (make-local-variable 'po-start-of-entry) |
| 1035 | (make-local-variable 'po-start-of-msgctxt) |
| 1036 | (make-local-variable 'po-start-of-msgid) |
| 1037 | (make-local-variable 'po-start-of-msgid_plural) |
| 1038 | (make-local-variable 'po-start-of-msgstr-block) |
| 1039 | (make-local-variable 'po-end-of-entry) |
| 1040 | (make-local-variable 'po-entry-type) |
| 1041 | |
| 1042 | (make-local-variable 'po-translated-counter) |
| 1043 | (make-local-variable 'po-fuzzy-counter) |
| 1044 | (make-local-variable 'po-untranslated-counter) |
| 1045 | (make-local-variable 'po-obsolete-counter) |
| 1046 | (make-local-variable 'po-mode-line-string) |
| 1047 | |
| 1048 | (setq po-mode-flag t) |
| 1049 | |
| 1050 | (po-check-file-header) |
| 1051 | (po-compute-counters nil) |
| 1052 | |
| 1053 | (set (make-local-variable 'po-edited-fields) nil) |
| 1054 | (set (make-local-variable 'po-marker-stack) nil) |
| 1055 | (set (make-local-variable 'po-search-path) '(("./") ("../"))) |
| 1056 | |
| 1057 | (set (make-local-variable 'po-reference-alist) nil) |
| 1058 | (set (make-local-variable 'po-reference-cursor) nil) |
| 1059 | (set (make-local-variable 'po-reference-check) 0) |
| 1060 | |
| 1061 | (set (make-local-variable 'po-keywords) |
| 1062 | '(("gettext") ("gettext_noop") ("_") ("N_"))) |
| 1063 | (set (make-local-variable 'po-string-contents) nil) |
| 1064 | (set (make-local-variable 'po-string-buffer) nil) |
| 1065 | (set (make-local-variable 'po-string-start) nil) |
| 1066 | (set (make-local-variable 'po-string-end) nil) |
| 1067 | (set (make-local-variable 'po-marking-overlay) (po-create-overlay)) |
| 1068 | |
| 1069 | (add-hook 'write-contents-hooks 'po-replace-revision-date) |
| 1070 | |
| 1071 | (run-hooks 'po-mode-hook) |
| 1072 | (message (_"You may type 'h' or '?' for a short PO mode reminder."))) |
| 1073 | |
| 1074 | (defvar po-subedit-mode-map |
| 1075 | ;; Use (make-keymap) because (make-sparse-keymap) does not work on Demacs. |
| 1076 | (let ((po-subedit-mode-map (make-keymap))) |
| 1077 | (define-key po-subedit-mode-map "\C-c\C-a" 'po-subedit-cycle-auxiliary) |
| 1078 | (define-key po-subedit-mode-map "\C-c\C-c" 'po-subedit-exit) |
| 1079 | (define-key po-subedit-mode-map "\C-c\C-e" 'po-subedit-ediff) |
| 1080 | (define-key po-subedit-mode-map "\C-c\C-k" 'po-subedit-abort) |
| 1081 | po-subedit-mode-map) |
| 1082 | "Keymap while editing a PO mode entry (or the full PO file).") |
| 1083 | \f |
| 1084 | ;;; Window management. |
| 1085 | |
| 1086 | (make-variable-buffer-local 'po-mode-flag) |
| 1087 | |
| 1088 | (defvar po-mode-line-entry '(po-mode-flag (" " po-mode-line-string)) |
| 1089 | "Mode line format entry displaying MODE-LINE-STRING.") |
| 1090 | |
| 1091 | ;; Insert MODE-LINE-ENTRY in mode line, but on first load only. |
| 1092 | (or (member po-mode-line-entry mode-line-format) |
| 1093 | ;; mode-line-format usually contains global-mode-string, but some |
| 1094 | ;; people customize this variable. As a last resort, append at the end. |
| 1095 | (let ((prev-entry (or (member 'global-mode-string mode-line-format) |
| 1096 | (member " " mode-line-format) |
| 1097 | (last mode-line-format)))) |
| 1098 | (setcdr prev-entry (cons po-mode-line-entry (cdr prev-entry))))) |
| 1099 | |
| 1100 | (defun po-update-mode-line-string () |
| 1101 | "Compute a new statistics string to display in mode line." |
| 1102 | (setq po-mode-line-string |
| 1103 | (concat (format "%dt" po-translated-counter) |
| 1104 | (if (> po-fuzzy-counter 0) |
| 1105 | (format "+%df" po-fuzzy-counter)) |
| 1106 | (if (> po-untranslated-counter 0) |
| 1107 | (format "+%du" po-untranslated-counter)) |
| 1108 | (if (> po-obsolete-counter 0) |
| 1109 | (format "+%do" po-obsolete-counter)))) |
| 1110 | (po-force-mode-line-update)) |
| 1111 | |
| 1112 | (defun po-type-counter () |
| 1113 | "Return the symbol name of the counter appropriate for the current entry." |
| 1114 | (cond ((eq po-entry-type 'obsolete) 'po-obsolete-counter) |
| 1115 | ((eq po-entry-type 'fuzzy) 'po-fuzzy-counter) |
| 1116 | ((eq po-entry-type 'translated) 'po-translated-counter) |
| 1117 | ((eq po-entry-type 'untranslated) 'po-untranslated-counter) |
| 1118 | (t (error (_"Unknown entry type"))))) |
| 1119 | |
| 1120 | (defun po-decrease-type-counter () |
| 1121 | "Decrease the counter corresponding to the nature of the current entry." |
| 1122 | (let ((counter (po-type-counter))) |
| 1123 | (set counter (1- (eval counter))))) |
| 1124 | |
| 1125 | (defun po-increase-type-counter () |
| 1126 | "Increase the counter corresponding to the nature of the current entry. |
| 1127 | Then, update the mode line counters." |
| 1128 | (let ((counter (po-type-counter))) |
| 1129 | (set counter (1+ (eval counter)))) |
| 1130 | (po-update-mode-line-string)) |
| 1131 | |
| 1132 | ;; Avoid byte compiler warnings. |
| 1133 | (defvar po-fuzzy-regexp) |
| 1134 | (defvar po-untranslated-regexp) |
| 1135 | |
| 1136 | (defun po-compute-counters (flag) |
| 1137 | "Prepare counters for mode line display. If FLAG, also echo entry position." |
| 1138 | (and flag (po-find-span-of-entry)) |
| 1139 | (setq po-translated-counter 0 |
| 1140 | po-fuzzy-counter 0 |
| 1141 | po-untranslated-counter 0 |
| 1142 | po-obsolete-counter 0) |
| 1143 | (let ((position 0) (total 0) current here) |
| 1144 | ;; FIXME 'here' looks obsolete / 2001-08-23 03:54:26 CEST -ke- |
| 1145 | (save-excursion |
| 1146 | (po-find-span-of-entry) |
| 1147 | (setq current po-start-of-msgstr-block) |
| 1148 | (goto-char (point-min)) |
| 1149 | ;; While counting, skip the header entry, for consistency with msgfmt. |
| 1150 | (po-find-span-of-entry) |
| 1151 | (if (string-equal (po-get-msgid) "") |
| 1152 | (goto-char po-end-of-entry)) |
| 1153 | (if (re-search-forward "^msgid" (point-max) t) |
| 1154 | (progn |
| 1155 | ;; Start counting |
| 1156 | (while (re-search-forward po-any-msgstr-block-regexp nil t) |
| 1157 | (and (= (% total 20) 0) |
| 1158 | (if flag |
| 1159 | (message (_"Position %d/%d") position total) |
| 1160 | (message (_"Position %d") total))) |
| 1161 | (setq here (point)) |
| 1162 | (goto-char (match-beginning 0)) |
| 1163 | (setq total (1+ total)) |
| 1164 | (and flag (eq (point) current) (setq position total)) |
| 1165 | (cond ((eq (following-char) ?#) |
| 1166 | (setq po-obsolete-counter (1+ po-obsolete-counter))) |
| 1167 | ((looking-at po-untranslated-regexp) |
| 1168 | (setq po-untranslated-counter (1+ po-untranslated-counter))) |
| 1169 | (t (setq po-translated-counter (1+ po-translated-counter)))) |
| 1170 | (goto-char here)) |
| 1171 | |
| 1172 | ;; Make another pass just for the fuzzy entries, kind of kludgey. |
| 1173 | ;; FIXME: Counts will be wrong if untranslated entries are fuzzy, yet |
| 1174 | ;; this should not normally happen. |
| 1175 | (goto-char (point-min)) |
| 1176 | (while (re-search-forward po-fuzzy-regexp nil t) |
| 1177 | (setq po-fuzzy-counter (1+ po-fuzzy-counter))) |
| 1178 | (setq po-translated-counter (- po-translated-counter po-fuzzy-counter))) |
| 1179 | '())) |
| 1180 | |
| 1181 | ;; Push the results out. |
| 1182 | (if flag |
| 1183 | (message (_"\ |
| 1184 | Position %d/%d; %d translated, %d fuzzy, %d untranslated, %d obsolete") |
| 1185 | position total po-translated-counter po-fuzzy-counter |
| 1186 | po-untranslated-counter po-obsolete-counter) |
| 1187 | (message ""))) |
| 1188 | (po-update-mode-line-string)) |
| 1189 | |
| 1190 | (defun po-redisplay () |
| 1191 | "Redisplay the current entry." |
| 1192 | ;; FIXME: Should try to fit the whole entry on the window. If this is not |
| 1193 | ;; possible, should try to fit the comment and the msgid. Otherwise, |
| 1194 | ;; should try to fit the msgid. Else, the first line of the msgid should |
| 1195 | ;; be at the top of the window. |
| 1196 | (goto-char po-start-of-msgid)) |
| 1197 | |
| 1198 | (defun po-other-window () |
| 1199 | "Get the cursor into another window, out of PO mode." |
| 1200 | (interactive) |
| 1201 | (if (one-window-p t) |
| 1202 | (progn |
| 1203 | (split-window) |
| 1204 | (switch-to-buffer (other-buffer))) |
| 1205 | (other-window 1))) |
| 1206 | \f |
| 1207 | ;;; Processing the PO file header entry. |
| 1208 | |
| 1209 | (defun po-check-file-header () |
| 1210 | "Create a missing PO mode file header, or replace an oldish one. |
| 1211 | Can be customized with the `po-auto-update-file-header' variable." |
| 1212 | (if (or (eq po-auto-update-file-header t) |
| 1213 | (and (eq po-auto-update-file-header 'ask) |
| 1214 | (y-or-n-p (_"May I update the PO Header Entry? ")))) |
| 1215 | (save-excursion |
| 1216 | (save-restriction |
| 1217 | (widen) ; in case of a narrowed view to the buffer |
| 1218 | (let ((buffer-read-only po-read-only) |
| 1219 | insert-flag end-of-header) |
| 1220 | (goto-char (point-min)) |
| 1221 | (if (re-search-forward po-any-msgstr-block-regexp nil t) |
| 1222 | (progn |
| 1223 | ;; There is at least one entry. |
| 1224 | (goto-char (match-beginning 0)) |
| 1225 | (forward-line -1) |
| 1226 | (setq end-of-header (match-end 0)) |
| 1227 | (if (looking-at "msgid \"\"\n") |
| 1228 | ;; There is indeed a PO file header. |
| 1229 | (if (re-search-forward "\n\"PO-Revision-Date: " |
| 1230 | end-of-header t) |
| 1231 | nil |
| 1232 | ;; This is an oldish header. Replace it all. |
| 1233 | (goto-char end-of-header) |
| 1234 | (while (> (point) (point-min)) |
| 1235 | (forward-line -1) |
| 1236 | (insert "#~ ") |
| 1237 | (beginning-of-line)) |
| 1238 | (beginning-of-line) |
| 1239 | (setq insert-flag t)) |
| 1240 | ;; The first entry is not a PO file header, insert one. |
| 1241 | (setq insert-flag t))) |
| 1242 | ;; Not a single entry found. |
| 1243 | (setq insert-flag t)) |
| 1244 | (goto-char (point-min)) |
| 1245 | (if insert-flag |
| 1246 | (progn |
| 1247 | (insert po-default-file-header) |
| 1248 | (if (not (eobp)) |
| 1249 | (insert "\n"))))))) |
| 1250 | (message (_"PO Header Entry was not updated...")))) |
| 1251 | |
| 1252 | (defun po-replace-revision-date () |
| 1253 | "Replace the revision date by current time in the PO file header." |
| 1254 | (if (fboundp 'format-time-string) |
| 1255 | (if (or (eq po-auto-replace-revision-date t) |
| 1256 | (and (eq po-auto-replace-revision-date 'ask) |
| 1257 | (y-or-n-p (_"May I set PO-Revision-Date? ")))) |
| 1258 | (save-excursion |
| 1259 | (goto-char (point-min)) |
| 1260 | (if (re-search-forward "^\"PO-Revision-Date:.*" nil t) |
| 1261 | (let* ((buffer-read-only po-read-only) |
| 1262 | (time (current-time)) |
| 1263 | (seconds (or (car (current-time-zone time)) 0)) |
| 1264 | (minutes (/ (abs seconds) 60)) |
| 1265 | (zone (format "%c%02d%02d" |
| 1266 | (if (< seconds 0) ?- ?+) |
| 1267 | (/ minutes 60) |
| 1268 | (% minutes 60)))) |
| 1269 | (replace-match |
| 1270 | (concat "\"PO-Revision-Date: " |
| 1271 | (format-time-string "%Y-%m-%d %H:%M" time) |
| 1272 | zone "\\n\"") |
| 1273 | t t)))) |
| 1274 | (message "")) |
| 1275 | (message (_"PO-Revision-Date should be adjusted..."))) |
| 1276 | ;; Return nil to indicate that the buffer has not yet been saved. |
| 1277 | nil) |
| 1278 | \f |
| 1279 | ;;; Handling span of entry, entry type and entry attributes. |
| 1280 | |
| 1281 | (defun po-find-span-of-entry () |
| 1282 | "Find the extent of the PO file entry where the cursor is. |
| 1283 | Set variables po-start-of-entry, po-start-of-msgctxt, po-start-of-msgid, |
| 1284 | po-start-of-msgid_plural, po-start-of-msgstr-block, po-end-of-entry, and |
| 1285 | po-entry-type to meaningful values. po-entry-type may be set to: obsolete, |
| 1286 | fuzzy, untranslated, or translated." |
| 1287 | (let ((here (point))) |
| 1288 | (if (re-search-backward po-any-msgstr-block-regexp nil t) |
| 1289 | (progn |
| 1290 | ;; After a backward match, (match-end 0) will not extend |
| 1291 | ;; beyond point, in case point was *inside* the regexp. We |
| 1292 | ;; need a dependable (match-end 0), so we redo the match in |
| 1293 | ;; the forward direction. |
| 1294 | (re-search-forward po-any-msgstr-block-regexp) |
| 1295 | (if (<= (match-end 0) here) |
| 1296 | (progn |
| 1297 | ;; We most probably found the msgstr of the previous |
| 1298 | ;; entry. The current entry then starts just after |
| 1299 | ;; its end, save this information just in case. |
| 1300 | (setq po-start-of-entry (match-end 0)) |
| 1301 | ;; However, it is also possible that we are located in |
| 1302 | ;; the crumb after the last entry in the file. If |
| 1303 | ;; yes, we know the middle and end of last PO entry. |
| 1304 | (setq po-start-of-msgstr-block (match-beginning 0) |
| 1305 | po-end-of-entry (match-end 0)) |
| 1306 | (if (re-search-forward po-any-msgstr-block-regexp nil t) |
| 1307 | (progn |
| 1308 | ;; We definitely were not in the crumb. |
| 1309 | (setq po-start-of-msgstr-block (match-beginning 0) |
| 1310 | po-end-of-entry (match-end 0))) |
| 1311 | ;; We were in the crumb. The start of the last PO |
| 1312 | ;; file entry is the end of the previous msgstr if |
| 1313 | ;; any, or else, the beginning of the file. |
| 1314 | (goto-char po-start-of-msgstr-block) |
| 1315 | (setq po-start-of-entry |
| 1316 | (if (re-search-backward po-any-msgstr-block-regexp nil t) |
| 1317 | (match-end 0) |
| 1318 | (point-min))))) |
| 1319 | ;; The cursor was inside msgstr of the current entry. |
| 1320 | (setq po-start-of-msgstr-block (match-beginning 0) |
| 1321 | po-end-of-entry (match-end 0)) |
| 1322 | ;; The start of this entry is the end of the previous |
| 1323 | ;; msgstr if any, or else, the beginning of the file. |
| 1324 | (goto-char po-start-of-msgstr-block) |
| 1325 | (setq po-start-of-entry |
| 1326 | (if (re-search-backward po-any-msgstr-block-regexp nil t) |
| 1327 | (match-end 0) |
| 1328 | (point-min))))) |
| 1329 | ;; The cursor was before msgstr in the first entry in the file. |
| 1330 | (setq po-start-of-entry (point-min)) |
| 1331 | (goto-char po-start-of-entry) |
| 1332 | ;; There is at least the PO file header, so this should match. |
| 1333 | (re-search-forward po-any-msgstr-block-regexp) |
| 1334 | (setq po-start-of-msgstr-block (match-beginning 0) |
| 1335 | po-end-of-entry (match-end 0))) |
| 1336 | ;; Find start of msgid. |
| 1337 | (goto-char po-start-of-entry) |
| 1338 | (re-search-forward po-any-msgctxt-msgid-regexp) |
| 1339 | (setq po-start-of-msgctxt (match-beginning 0)) |
| 1340 | (goto-char po-start-of-entry) |
| 1341 | (re-search-forward po-any-msgid-regexp) |
| 1342 | (setq po-start-of-msgid (match-beginning 0)) |
| 1343 | (save-excursion |
| 1344 | (goto-char po-start-of-msgid) |
| 1345 | (setq po-start-of-msgid_plural |
| 1346 | (if (re-search-forward po-any-msgid_plural-regexp |
| 1347 | po-start-of-msgstr-block t) |
| 1348 | (match-beginning 0) |
| 1349 | nil))) |
| 1350 | (save-excursion |
| 1351 | (when (>= here po-start-of-msgstr-block) |
| 1352 | ;; point was somewhere inside of msgstr* |
| 1353 | (goto-char here) |
| 1354 | (end-of-line) |
| 1355 | (re-search-backward "^\\(#~[ \t]*\\)?msgstr")) |
| 1356 | ;; Detect the boundaries of the msgstr we are interested in. |
| 1357 | (re-search-forward po-any-msgstr-form-regexp) |
| 1358 | (setq po-start-of-msgstr-form (match-beginning 0) |
| 1359 | po-end-of-msgstr-form (match-end 0))) |
| 1360 | ;; Classify the entry. |
| 1361 | (setq po-entry-type |
| 1362 | (if (eq (following-char) ?#) |
| 1363 | 'obsolete |
| 1364 | (goto-char po-start-of-entry) |
| 1365 | (if (re-search-forward po-fuzzy-regexp po-start-of-msgctxt t) |
| 1366 | 'fuzzy |
| 1367 | (goto-char po-start-of-msgstr-block) |
| 1368 | (if (looking-at po-untranslated-regexp) |
| 1369 | 'untranslated |
| 1370 | 'translated)))) |
| 1371 | ;; Put the cursor back where it was. |
| 1372 | (goto-char here))) |
| 1373 | |
| 1374 | (defun po-add-attribute (name) |
| 1375 | "Add attribute NAME to the current entry, unless it is already there." |
| 1376 | (save-excursion |
| 1377 | (let ((buffer-read-only po-read-only)) |
| 1378 | (goto-char po-start-of-entry) |
| 1379 | (if (re-search-forward "\n#, .*" po-start-of-msgctxt t) |
| 1380 | (save-restriction |
| 1381 | (narrow-to-region (match-beginning 0) (match-end 0)) |
| 1382 | (goto-char (point-min)) |
| 1383 | (if (re-search-forward (concat "\\b" name "\\b") nil t) |
| 1384 | nil |
| 1385 | (goto-char (point-max)) |
| 1386 | (insert ", " name))) |
| 1387 | (skip-chars-forward "\n") |
| 1388 | (while (eq (following-char) ?#) |
| 1389 | (forward-line 1)) |
| 1390 | (insert "#, " name "\n"))))) |
| 1391 | |
| 1392 | (defun po-delete-attribute (name) |
| 1393 | "Delete attribute NAME from the current entry, if any." |
| 1394 | (save-excursion |
| 1395 | (let ((buffer-read-only po-read-only)) |
| 1396 | (goto-char po-start-of-entry) |
| 1397 | (if (re-search-forward "\n#, .*" po-start-of-msgctxt t) |
| 1398 | (save-restriction |
| 1399 | (narrow-to-region (match-beginning 0) (match-end 0)) |
| 1400 | (goto-char (point-min)) |
| 1401 | (if (re-search-forward |
| 1402 | (concat "\\(\n#, " name "$\\|, " name "$\\| " name ",\\)") |
| 1403 | nil t) |
| 1404 | (replace-match "" t t))))))) |
| 1405 | \f |
| 1406 | ;;; Entry positionning. |
| 1407 | |
| 1408 | (defun po-say-location-depth () |
| 1409 | "Tell how many entries in the entry location stack." |
| 1410 | (let ((depth (length po-marker-stack))) |
| 1411 | (cond ((= depth 0) (message (_"Empty location stack"))) |
| 1412 | ((= depth 1) (message (_"One entry in location stack"))) |
| 1413 | (t (message (_"%d entries in location stack") depth))))) |
| 1414 | |
| 1415 | (defun po-push-location () |
| 1416 | "Stack the location of the current entry, for later return." |
| 1417 | (interactive) |
| 1418 | (po-find-span-of-entry) |
| 1419 | (save-excursion |
| 1420 | (goto-char po-start-of-msgid) |
| 1421 | (setq po-marker-stack (cons (point-marker) po-marker-stack))) |
| 1422 | (po-say-location-depth)) |
| 1423 | |
| 1424 | (defun po-pop-location () |
| 1425 | "Unstack a saved location, and return to the corresponding entry." |
| 1426 | (interactive) |
| 1427 | (if po-marker-stack |
| 1428 | (progn |
| 1429 | (goto-char (car po-marker-stack)) |
| 1430 | (setq po-marker-stack (cdr po-marker-stack)) |
| 1431 | (po-current-entry) |
| 1432 | (po-say-location-depth)) |
| 1433 | (error (_"The entry location stack is empty")))) |
| 1434 | |
| 1435 | (defun po-exchange-location () |
| 1436 | "Exchange the location of the current entry with the top of stack." |
| 1437 | (interactive) |
| 1438 | (if po-marker-stack |
| 1439 | (progn |
| 1440 | (po-find-span-of-entry) |
| 1441 | (goto-char po-start-of-msgid) |
| 1442 | (let ((location (point-marker))) |
| 1443 | (goto-char (car po-marker-stack)) |
| 1444 | (setq po-marker-stack (cons location (cdr po-marker-stack)))) |
| 1445 | (po-current-entry) |
| 1446 | (po-say-location-depth)) |
| 1447 | (error (_"The entry location stack is empty")))) |
| 1448 | |
| 1449 | (defun po-current-entry () |
| 1450 | "Display the current entry." |
| 1451 | (interactive) |
| 1452 | (po-find-span-of-entry) |
| 1453 | (po-redisplay)) |
| 1454 | |
| 1455 | (defun po-first-entry-with-regexp (regexp) |
| 1456 | "Display the first entry in the file which msgstr matches REGEXP." |
| 1457 | (let ((here (point))) |
| 1458 | (goto-char (point-min)) |
| 1459 | (if (re-search-forward regexp nil t) |
| 1460 | (progn |
| 1461 | (goto-char (match-beginning 0)) |
| 1462 | (po-current-entry)) |
| 1463 | (goto-char here) |
| 1464 | (error (_"There is no such entry"))))) |
| 1465 | |
| 1466 | (defun po-last-entry-with-regexp (regexp) |
| 1467 | "Display the last entry in the file which msgstr matches REGEXP." |
| 1468 | (let ((here (point))) |
| 1469 | (goto-char (point-max)) |
| 1470 | (if (re-search-backward regexp nil t) |
| 1471 | (po-current-entry) |
| 1472 | (goto-char here) |
| 1473 | (error (_"There is no such entry"))))) |
| 1474 | |
| 1475 | (defun po-next-entry-with-regexp (regexp wrap) |
| 1476 | "Display the entry following the current entry which msgstr matches REGEXP. |
| 1477 | If WRAP is not nil, the search may wrap around the buffer." |
| 1478 | (po-find-span-of-entry) |
| 1479 | (let ((here (point))) |
| 1480 | (goto-char po-end-of-entry) |
| 1481 | (if (re-search-forward regexp nil t) |
| 1482 | (progn |
| 1483 | (goto-char (match-beginning 0)) |
| 1484 | (po-current-entry)) |
| 1485 | (if (and wrap |
| 1486 | (progn |
| 1487 | (goto-char (point-min)) |
| 1488 | (re-search-forward regexp po-start-of-entry t))) |
| 1489 | (progn |
| 1490 | (goto-char (match-beginning 0)) |
| 1491 | (po-current-entry) |
| 1492 | (message (_"Wrapping around the buffer"))) |
| 1493 | (goto-char here) |
| 1494 | (error (_"There is no such entry")))))) |
| 1495 | |
| 1496 | (defun po-previous-entry-with-regexp (regexp wrap) |
| 1497 | "Redisplay the entry preceding the current entry which msgstr matches REGEXP. |
| 1498 | If WRAP is not nil, the search may wrap around the buffer." |
| 1499 | (po-find-span-of-entry) |
| 1500 | (let ((here (point))) |
| 1501 | (goto-char po-start-of-entry) |
| 1502 | (if (re-search-backward regexp nil t) |
| 1503 | (po-current-entry) |
| 1504 | (if (and wrap |
| 1505 | (progn |
| 1506 | (goto-char (point-max)) |
| 1507 | (re-search-backward regexp po-end-of-entry t))) |
| 1508 | (progn |
| 1509 | (po-current-entry) |
| 1510 | (message (_"Wrapping around the buffer"))) |
| 1511 | (goto-char here) |
| 1512 | (error (_"There is no such entry")))))) |
| 1513 | |
| 1514 | ;; Any entries. |
| 1515 | |
| 1516 | (defun po-first-entry () |
| 1517 | "Display the first entry." |
| 1518 | (interactive) |
| 1519 | (po-first-entry-with-regexp po-any-msgstr-block-regexp)) |
| 1520 | |
| 1521 | (defun po-last-entry () |
| 1522 | "Display the last entry." |
| 1523 | (interactive) |
| 1524 | (po-last-entry-with-regexp po-any-msgstr-block-regexp)) |
| 1525 | |
| 1526 | (defun po-next-entry () |
| 1527 | "Display the entry following the current entry." |
| 1528 | (interactive) |
| 1529 | (po-next-entry-with-regexp po-any-msgstr-block-regexp nil)) |
| 1530 | |
| 1531 | (defun po-previous-entry () |
| 1532 | "Display the entry preceding the current entry." |
| 1533 | (interactive) |
| 1534 | (po-previous-entry-with-regexp po-any-msgstr-block-regexp nil)) |
| 1535 | |
| 1536 | ;; Untranslated entries. |
| 1537 | |
| 1538 | (defvar po-after-entry-regexp |
| 1539 | "\\(\\'\\|\\(#[ \t]*\\)?$\\)" |
| 1540 | "Regexp which should be true after a full msgstr string matched.") |
| 1541 | |
| 1542 | (defvar po-untranslated-regexp |
| 1543 | (concat "^msgstr\\(\\[[0-9]\\]\\)?[ \t]*\"\"\n" po-after-entry-regexp) |
| 1544 | "Regexp matching a whole msgstr field, but only if active and empty.") |
| 1545 | |
| 1546 | (defun po-next-untranslated-entry () |
| 1547 | "Find the next untranslated entry, wrapping around if necessary." |
| 1548 | (interactive) |
| 1549 | (po-next-entry-with-regexp po-untranslated-regexp t)) |
| 1550 | |
| 1551 | (defun po-previous-untranslated-entry () |
| 1552 | "Find the previous untranslated entry, wrapping around if necessary." |
| 1553 | (interactive) |
| 1554 | (po-previous-entry-with-regexp po-untranslated-regexp t)) |
| 1555 | |
| 1556 | (defun po-msgid-to-msgstr () |
| 1557 | "Use another window to edit msgstr reinitialized with msgid." |
| 1558 | (interactive) |
| 1559 | (po-find-span-of-entry) |
| 1560 | (if (or (eq po-entry-type 'untranslated) |
| 1561 | (eq po-entry-type 'obsolete) |
| 1562 | (prog1 (y-or-n-p (_"Really lose previous translation? ")) |
| 1563 | (message ""))) |
| 1564 | ;; In an entry with plural forms, use the msgid_plural string, |
| 1565 | ;; as it is more general than the msgid string. |
| 1566 | (if (po-set-msgstr-form (or (po-get-msgid_plural) (po-get-msgid))) |
| 1567 | (po-maybe-delete-previous-untranslated)))) |
| 1568 | |
| 1569 | ;; Obsolete entries. |
| 1570 | |
| 1571 | (defvar po-obsolete-msgstr-regexp |
| 1572 | "^#~[ \t]*msgstr.*\n\\(#~[ \t]*\".*\n\\)*" |
| 1573 | "Regexp matching a whole msgstr field of an obsolete entry.") |
| 1574 | |
| 1575 | (defun po-next-obsolete-entry () |
| 1576 | "Find the next obsolete entry, wrapping around if necessary." |
| 1577 | (interactive) |
| 1578 | (po-next-entry-with-regexp po-obsolete-msgstr-regexp t)) |
| 1579 | |
| 1580 | (defun po-previous-obsolete-entry () |
| 1581 | "Find the previous obsolete entry, wrapping around if necessary." |
| 1582 | (interactive) |
| 1583 | (po-previous-entry-with-regexp po-obsolete-msgstr-regexp t)) |
| 1584 | |
| 1585 | ;; Fuzzy entries. |
| 1586 | |
| 1587 | (defvar po-fuzzy-regexp "^#, .*fuzzy" |
| 1588 | "Regexp matching the string inserted by msgmerge for translations |
| 1589 | which does not match exactly.") |
| 1590 | |
| 1591 | (defun po-next-fuzzy-entry () |
| 1592 | "Find the next fuzzy entry, wrapping around if necessary." |
| 1593 | (interactive) |
| 1594 | (po-next-entry-with-regexp po-fuzzy-regexp t)) |
| 1595 | |
| 1596 | (defun po-previous-fuzzy-entry () |
| 1597 | "Find the next fuzzy entry, wrapping around if necessary." |
| 1598 | (interactive) |
| 1599 | (po-previous-entry-with-regexp po-fuzzy-regexp t)) |
| 1600 | |
| 1601 | (defun po-unfuzzy () |
| 1602 | "Remove the fuzzy attribute for the current entry." |
| 1603 | (interactive) |
| 1604 | (po-find-span-of-entry) |
| 1605 | (cond ((eq po-entry-type 'fuzzy) |
| 1606 | (po-decrease-type-counter) |
| 1607 | (po-delete-attribute "fuzzy") |
| 1608 | (po-maybe-delete-previous-untranslated) |
| 1609 | (po-current-entry) |
| 1610 | (po-increase-type-counter))) |
| 1611 | (if po-auto-select-on-unfuzzy |
| 1612 | (po-auto-select-entry)) |
| 1613 | (po-update-mode-line-string)) |
| 1614 | |
| 1615 | ;; Translated entries. |
| 1616 | |
| 1617 | (defun po-next-translated-entry () |
| 1618 | "Find the next translated entry, wrapping around if necessary." |
| 1619 | (interactive) |
| 1620 | (if (= po-translated-counter 0) |
| 1621 | (error (_"There is no such entry")) |
| 1622 | (po-next-entry-with-regexp po-any-msgstr-block-regexp t) |
| 1623 | (po-find-span-of-entry) |
| 1624 | (while (not (eq po-entry-type 'translated)) |
| 1625 | (po-next-entry-with-regexp po-any-msgstr-block-regexp t) |
| 1626 | (po-find-span-of-entry)))) |
| 1627 | |
| 1628 | (defun po-previous-translated-entry () |
| 1629 | "Find the previous translated entry, wrapping around if necessary." |
| 1630 | (interactive) |
| 1631 | (if (= po-translated-counter 0) |
| 1632 | (error (_"There is no such entry")) |
| 1633 | (po-previous-entry-with-regexp po-any-msgstr-block-regexp t) |
| 1634 | (po-find-span-of-entry) |
| 1635 | (while (not (eq po-entry-type 'translated)) |
| 1636 | (po-previous-entry-with-regexp po-any-msgstr-block-regexp t) |
| 1637 | (po-find-span-of-entry)))) |
| 1638 | |
| 1639 | ;; Auto-selection feature. |
| 1640 | |
| 1641 | (defun po-auto-select-entry () |
| 1642 | "Select the next entry having the same type as the current one. |
| 1643 | If none, wrap from the beginning of the buffer with another type, |
| 1644 | going from untranslated to fuzzy, and from fuzzy to obsolete. |
| 1645 | Plain translated entries are always disregarded unless there are |
| 1646 | no entries of the other types." |
| 1647 | (interactive) |
| 1648 | (po-find-span-of-entry) |
| 1649 | (goto-char po-end-of-entry) |
| 1650 | (if (and (= po-untranslated-counter 0) |
| 1651 | (= po-fuzzy-counter 0) |
| 1652 | (= po-obsolete-counter 0)) |
| 1653 | ;; All entries are plain translated. Next entry will do, or |
| 1654 | ;; wrap around if there is none. |
| 1655 | (if (re-search-forward po-any-msgstr-block-regexp nil t) |
| 1656 | (goto-char (match-beginning 0)) |
| 1657 | (goto-char (point-min))) |
| 1658 | ;; If over a translated entry, look for an untranslated one first. |
| 1659 | ;; Else, look for an entry of the same type first. |
| 1660 | (let ((goal (if (eq po-entry-type 'translated) |
| 1661 | 'untranslated |
| 1662 | po-entry-type))) |
| 1663 | (while goal |
| 1664 | ;; Find an untranslated entry, or wrap up for a fuzzy entry. |
| 1665 | (if (eq goal 'untranslated) |
| 1666 | (if (and (> po-untranslated-counter 0) |
| 1667 | (re-search-forward po-untranslated-regexp nil t)) |
| 1668 | (progn |
| 1669 | (goto-char (match-beginning 0)) |
| 1670 | (setq goal nil)) |
| 1671 | (goto-char (point-min)) |
| 1672 | (setq goal 'fuzzy))) |
| 1673 | ;; Find a fuzzy entry, or wrap up for an obsolete entry. |
| 1674 | (if (eq goal 'fuzzy) |
| 1675 | (if (and (> po-fuzzy-counter 0) |
| 1676 | (re-search-forward po-fuzzy-regexp nil t)) |
| 1677 | (progn |
| 1678 | (goto-char (match-beginning 0)) |
| 1679 | (setq goal nil)) |
| 1680 | (goto-char (point-min)) |
| 1681 | (setq goal 'obsolete))) |
| 1682 | ;; Find an obsolete entry, or wrap up for an untranslated entry. |
| 1683 | (if (eq goal 'obsolete) |
| 1684 | (if (and (> po-obsolete-counter 0) |
| 1685 | (re-search-forward po-obsolete-msgstr-regexp nil t)) |
| 1686 | (progn |
| 1687 | (goto-char (match-beginning 0)) |
| 1688 | (setq goal nil)) |
| 1689 | (goto-char (point-min)) |
| 1690 | (setq goal 'untranslated)))))) |
| 1691 | ;; Display this entry nicely. |
| 1692 | (po-current-entry)) |
| 1693 | \f |
| 1694 | ;;; Killing and yanking fields. |
| 1695 | |
| 1696 | (defun po-extract-unquoted (buffer start end) |
| 1697 | "Extract and return the unquoted string in BUFFER going from START to END. |
| 1698 | Crumb preceding or following the quoted string is ignored." |
| 1699 | (save-excursion |
| 1700 | (goto-char start) |
| 1701 | (search-forward "\"") |
| 1702 | (setq start (point)) |
| 1703 | (goto-char end) |
| 1704 | (search-backward "\"") |
| 1705 | (setq end (point))) |
| 1706 | (po-extract-part-unquoted buffer start end)) |
| 1707 | |
| 1708 | (defun po-extract-part-unquoted (buffer start end) |
| 1709 | "Extract and return the unquoted string in BUFFER going from START to END. |
| 1710 | Surrounding quotes are already excluded by the position of START and END." |
| 1711 | (po-with-temp-buffer |
| 1712 | (insert-buffer-substring buffer start end) |
| 1713 | ;; Glue concatenated strings. |
| 1714 | (goto-char (point-min)) |
| 1715 | (while (re-search-forward "\"[ \t]*\\\\?\n\\(#~\\)?[ \t]*\"" nil t) |
| 1716 | (replace-match "" t t)) |
| 1717 | ;; Remove escaped newlines. |
| 1718 | (goto-char (point-min)) |
| 1719 | (while (re-search-forward "\\\\[ \t]*\n" nil t) |
| 1720 | (replace-match "" t t)) |
| 1721 | ;; Unquote individual characters. |
| 1722 | (goto-char (point-min)) |
| 1723 | (while (re-search-forward "\\\\[\"abfnt\\0-7]" nil t) |
| 1724 | (cond ((eq (preceding-char) ?\") (replace-match "\"" t t)) |
| 1725 | ((eq (preceding-char) ?a) (replace-match "\a" t t)) |
| 1726 | ((eq (preceding-char) ?b) (replace-match "\b" t t)) |
| 1727 | ((eq (preceding-char) ?f) (replace-match "\f" t t)) |
| 1728 | ((eq (preceding-char) ?n) (replace-match "\n" t t)) |
| 1729 | ((eq (preceding-char) ?t) (replace-match "\t" t t)) |
| 1730 | ((eq (preceding-char) ?\\) (replace-match "\\" t t)) |
| 1731 | (t (let ((value (- (preceding-char) ?0))) |
| 1732 | (replace-match "" t t) |
| 1733 | (while (looking-at "[0-7]") |
| 1734 | (setq value (+ (* 8 value) (- (following-char) ?0))) |
| 1735 | (replace-match "" t t)) |
| 1736 | (insert value))))) |
| 1737 | (buffer-string))) |
| 1738 | |
| 1739 | (defun po-eval-requoted (form prefix obsolete) |
| 1740 | "Eval FORM, which inserts a string, and return the string fully requoted. |
| 1741 | If PREFIX, precede the result with its contents. If OBSOLETE, comment all |
| 1742 | generated lines in the returned string. Evaluating FORM should insert the |
| 1743 | wanted string in the buffer which is current at the time of evaluation. |
| 1744 | If FORM is itself a string, then this string is used for insertion." |
| 1745 | (po-with-temp-buffer |
| 1746 | (if (stringp form) |
| 1747 | (insert form) |
| 1748 | (push-mark) |
| 1749 | (eval form)) |
| 1750 | (goto-char (point-min)) |
| 1751 | (let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t))) |
| 1752 | (goto-char (point-min)) |
| 1753 | (while (re-search-forward "[\"\a\b\f\n\r\t\\]" nil t) |
| 1754 | (cond ((eq (preceding-char) ?\") (replace-match "\\\"" t t)) |
| 1755 | ((eq (preceding-char) ?\a) (replace-match "\\a" t t)) |
| 1756 | ((eq (preceding-char) ?\b) (replace-match "\\b" t t)) |
| 1757 | ((eq (preceding-char) ?\f) (replace-match "\\f" t t)) |
| 1758 | ((eq (preceding-char) ?\n) |
| 1759 | (replace-match (if (or (not multi-line) (eobp)) |
| 1760 | "\\n" |
| 1761 | "\\n\"\n\"") |
| 1762 | t t)) |
| 1763 | ((eq (preceding-char) ?\r) (replace-match "\\r" t t)) |
| 1764 | ((eq (preceding-char) ?\t) (replace-match "\\t" t t)) |
| 1765 | ((eq (preceding-char) ?\\) (replace-match "\\\\" t t)))) |
| 1766 | (goto-char (point-min)) |
| 1767 | (if prefix (insert prefix " ")) |
| 1768 | (insert (if multi-line "\"\"\n\"" "\"")) |
| 1769 | (goto-char (point-max)) |
| 1770 | (insert "\"") |
| 1771 | (if prefix (insert "\n")) |
| 1772 | (if obsolete |
| 1773 | (progn |
| 1774 | (goto-char (point-min)) |
| 1775 | (while (not (eobp)) |
| 1776 | (or (eq (following-char) ?\n) (insert "#~ ")) |
| 1777 | (search-forward "\n")))) |
| 1778 | (buffer-string)))) |
| 1779 | |
| 1780 | (defun po-get-msgid () |
| 1781 | "Extract and return the unquoted msgid string." |
| 1782 | (let ((string (po-extract-unquoted (current-buffer) |
| 1783 | po-start-of-msgid |
| 1784 | (or po-start-of-msgid_plural |
| 1785 | po-start-of-msgstr-block)))) |
| 1786 | string)) |
| 1787 | |
| 1788 | (defun po-get-msgid_plural () |
| 1789 | "Extract and return the unquoted msgid_plural string. |
| 1790 | Return nil if it is not present." |
| 1791 | (if po-start-of-msgid_plural |
| 1792 | (let ((string (po-extract-unquoted (current-buffer) |
| 1793 | po-start-of-msgid_plural |
| 1794 | po-start-of-msgstr-block))) |
| 1795 | string) |
| 1796 | nil)) |
| 1797 | |
| 1798 | (defun po-get-msgstr-flavor () |
| 1799 | "Helper function to detect msgstr and msgstr[] variants. |
| 1800 | Returns one of \"msgstr\" or \"msgstr[i]\" for some i." |
| 1801 | (save-excursion |
| 1802 | (goto-char po-start-of-msgstr-form) |
| 1803 | (re-search-forward "^\\(#~[ \t]*\\)?\\(msgstr\\(\\[[0-9]\\]\\)?\\)") |
| 1804 | (match-string 2))) |
| 1805 | |
| 1806 | (defun po-get-msgstr-form () |
| 1807 | "Extract and return the unquoted msgstr string." |
| 1808 | (let ((string (po-extract-unquoted (current-buffer) |
| 1809 | po-start-of-msgstr-form |
| 1810 | po-end-of-msgstr-form))) |
| 1811 | string)) |
| 1812 | |
| 1813 | (defun po-set-msgid (form) |
| 1814 | "Replace the current msgid, using FORM to get a string. |
| 1815 | Evaluating FORM should insert the wanted string in the current buffer. If |
| 1816 | FORM is itself a string, then this string is used for insertion. The string |
| 1817 | is properly requoted before the replacement occurs. |
| 1818 | |
| 1819 | Returns 'nil' if the buffer has not been modified, for if the new msgid |
| 1820 | described by FORM is merely identical to the msgid already in place." |
| 1821 | (let ((string (po-eval-requoted form "msgid" (eq po-entry-type 'obsolete)))) |
| 1822 | (save-excursion |
| 1823 | (goto-char po-start-of-entry) |
| 1824 | (re-search-forward po-any-msgid-regexp po-start-of-msgstr-block) |
| 1825 | (and (not (string-equal (po-match-string 0) string)) |
| 1826 | (let ((buffer-read-only po-read-only)) |
| 1827 | (replace-match string t t) |
| 1828 | (goto-char po-start-of-msgid) |
| 1829 | (po-find-span-of-entry) |
| 1830 | t))))) |
| 1831 | |
| 1832 | (defun po-set-msgstr-form (form) |
| 1833 | "Replace the current msgstr or msgstr[], using FORM to get a string. |
| 1834 | Evaluating FORM should insert the wanted string in the current buffer. If |
| 1835 | FORM is itself a string, then this string is used for insertion. The string |
| 1836 | is properly requoted before the replacement occurs. |
| 1837 | |
| 1838 | Returns 'nil' if the buffer has not been modified, for if the new msgstr |
| 1839 | described by FORM is merely identical to the msgstr already in place." |
| 1840 | (let ((string (po-eval-requoted form |
| 1841 | (po-get-msgstr-flavor) |
| 1842 | (eq po-entry-type 'obsolete)))) |
| 1843 | (save-excursion |
| 1844 | (goto-char po-start-of-msgstr-form) |
| 1845 | (re-search-forward po-any-msgstr-form-regexp po-end-of-msgstr-form) |
| 1846 | (and (not (string-equal (po-match-string 0) string)) |
| 1847 | (let ((buffer-read-only po-read-only)) |
| 1848 | (po-decrease-type-counter) |
| 1849 | (replace-match string t t) |
| 1850 | (goto-char po-start-of-msgid) |
| 1851 | (po-find-span-of-entry) |
| 1852 | (po-increase-type-counter) |
| 1853 | t))))) |
| 1854 | |
| 1855 | (defun po-kill-ring-save-msgstr () |
| 1856 | "Push the msgstr string from current entry on the kill ring." |
| 1857 | (interactive) |
| 1858 | (po-find-span-of-entry) |
| 1859 | (let ((string (po-get-msgstr-form))) |
| 1860 | (po-kill-new string) |
| 1861 | string)) |
| 1862 | |
| 1863 | (defun po-kill-msgstr () |
| 1864 | "Empty the msgstr string from current entry, pushing it on the kill ring." |
| 1865 | (interactive) |
| 1866 | (po-kill-ring-save-msgstr) |
| 1867 | (if (po-set-msgstr-form "") |
| 1868 | (po-maybe-delete-previous-untranslated))) |
| 1869 | |
| 1870 | (defun po-yank-msgstr () |
| 1871 | "Replace the current msgstr string by the top of the kill ring." |
| 1872 | (interactive) |
| 1873 | (po-find-span-of-entry) |
| 1874 | (if (po-set-msgstr-form (if (eq last-command 'yank) '(yank-pop 1) '(yank))) |
| 1875 | (po-maybe-delete-previous-untranslated)) |
| 1876 | (setq this-command 'yank)) |
| 1877 | |
| 1878 | (defun po-fade-out-entry () |
| 1879 | "Mark an active entry as fuzzy; obsolete a fuzzy or untranslated entry; |
| 1880 | or completely delete an obsolete entry, saving its msgstr on the kill ring." |
| 1881 | (interactive) |
| 1882 | (po-find-span-of-entry) |
| 1883 | |
| 1884 | (cond ((eq po-entry-type 'translated) |
| 1885 | (po-decrease-type-counter) |
| 1886 | (po-add-attribute "fuzzy") |
| 1887 | (po-current-entry) |
| 1888 | (po-increase-type-counter)) |
| 1889 | |
| 1890 | ((or (eq po-entry-type 'fuzzy) |
| 1891 | (eq po-entry-type 'untranslated)) |
| 1892 | (if (y-or-n-p (_"Should I really obsolete this entry? ")) |
| 1893 | (progn |
| 1894 | (po-decrease-type-counter) |
| 1895 | (save-excursion |
| 1896 | (save-restriction |
| 1897 | (narrow-to-region po-start-of-entry po-end-of-entry) |
| 1898 | (let ((buffer-read-only po-read-only)) |
| 1899 | (goto-char (point-min)) |
| 1900 | (skip-chars-forward "\n") |
| 1901 | (while (not (eobp)) |
| 1902 | (insert "#~ ") |
| 1903 | (search-forward "\n"))))) |
| 1904 | (po-current-entry) |
| 1905 | (po-increase-type-counter))) |
| 1906 | (message "")) |
| 1907 | |
| 1908 | ((and (eq po-entry-type 'obsolete) |
| 1909 | (po-check-for-pending-edit po-start-of-msgid) |
| 1910 | (po-check-for-pending-edit po-start-of-msgstr-block)) |
| 1911 | (po-decrease-type-counter) |
| 1912 | (po-update-mode-line-string) |
| 1913 | ;; TODO: Should save all msgstr forms here, not just one. |
| 1914 | (po-kill-new (po-get-msgstr-form)) |
| 1915 | (let ((buffer-read-only po-read-only)) |
| 1916 | (delete-region po-start-of-entry po-end-of-entry)) |
| 1917 | (goto-char po-start-of-entry) |
| 1918 | (if (re-search-forward po-any-msgstr-block-regexp nil t) |
| 1919 | (goto-char (match-beginning 0)) |
| 1920 | (re-search-backward po-any-msgstr-block-regexp nil t)) |
| 1921 | (po-current-entry) |
| 1922 | (message "")))) |
| 1923 | \f |
| 1924 | ;;; Killing and yanking comments. |
| 1925 | |
| 1926 | (defvar po-comment-regexp |
| 1927 | "^\\(#\n\\|# .*\n\\)+" |
| 1928 | "Regexp matching the whole editable comment part of an entry.") |
| 1929 | |
| 1930 | (defun po-get-comment (kill-flag) |
| 1931 | "Extract and return the editable comment string, uncommented. |
| 1932 | If KILL-FLAG, then add the unquoted comment to the kill ring." |
| 1933 | (let ((buffer (current-buffer)) |
| 1934 | (obsolete (eq po-entry-type 'obsolete))) |
| 1935 | (save-excursion |
| 1936 | (goto-char po-start-of-entry) |
| 1937 | (if (re-search-forward po-comment-regexp po-end-of-entry t) |
| 1938 | (po-with-temp-buffer |
| 1939 | (insert-buffer-substring buffer (match-beginning 0) (match-end 0)) |
| 1940 | (goto-char (point-min)) |
| 1941 | (while (not (eobp)) |
| 1942 | (if (looking-at (if obsolete "#\\(\n\\| \\)" "# ?")) |
| 1943 | (replace-match "" t t)) |
| 1944 | (forward-line 1)) |
| 1945 | (and kill-flag (copy-region-as-kill (point-min) (point-max))) |
| 1946 | (buffer-string)) |
| 1947 | "")))) |
| 1948 | |
| 1949 | (defun po-set-comment (form) |
| 1950 | "Using FORM to get a string, replace the current editable comment. |
| 1951 | Evaluating FORM should insert the wanted string in the current buffer. |
| 1952 | If FORM is itself a string, then this string is used for insertion. |
| 1953 | The string is properly recommented before the replacement occurs." |
| 1954 | (let ((obsolete (eq po-entry-type 'obsolete)) |
| 1955 | string) |
| 1956 | (po-with-temp-buffer |
| 1957 | (if (stringp form) |
| 1958 | (insert form) |
| 1959 | (push-mark) |
| 1960 | (eval form)) |
| 1961 | (if (not (or (bobp) (= (preceding-char) ?\n))) |
| 1962 | (insert "\n")) |
| 1963 | (goto-char (point-min)) |
| 1964 | (while (not (eobp)) |
| 1965 | (insert (if (= (following-char) ?\n) "#" "# ")) |
| 1966 | (search-forward "\n")) |
| 1967 | (setq string (buffer-string))) |
| 1968 | (goto-char po-start-of-entry) |
| 1969 | (if (re-search-forward po-comment-regexp po-end-of-entry t) |
| 1970 | (if (not (string-equal (po-match-string 0) string)) |
| 1971 | (let ((buffer-read-only po-read-only)) |
| 1972 | (replace-match string t t))) |
| 1973 | (skip-chars-forward " \t\n") |
| 1974 | (let ((buffer-read-only po-read-only)) |
| 1975 | (insert string)))) |
| 1976 | (po-current-entry)) |
| 1977 | |
| 1978 | (defun po-kill-ring-save-comment () |
| 1979 | "Push the msgstr string from current entry on the kill ring." |
| 1980 | (interactive) |
| 1981 | (po-find-span-of-entry) |
| 1982 | (po-get-comment t)) |
| 1983 | |
| 1984 | (defun po-kill-comment () |
| 1985 | "Empty the msgstr string from current entry, pushing it on the kill ring." |
| 1986 | (interactive) |
| 1987 | (po-kill-ring-save-comment) |
| 1988 | (po-set-comment "") |
| 1989 | (po-redisplay)) |
| 1990 | |
| 1991 | (defun po-yank-comment () |
| 1992 | "Replace the current comment string by the top of the kill ring." |
| 1993 | (interactive) |
| 1994 | (po-find-span-of-entry) |
| 1995 | (po-set-comment (if (eq last-command 'yank) '(yank-pop 1) '(yank))) |
| 1996 | (setq this-command 'yank) |
| 1997 | (po-redisplay)) |
| 1998 | |
| 1999 | ;;; Deleting the "previous untranslated" comment. |
| 2000 | |
| 2001 | (defun po-previous-untranslated-region-for (rx) |
| 2002 | "Return the list of previous untranslated regions (at most one) for the |
| 2003 | given regular expression RX." |
| 2004 | (save-excursion |
| 2005 | (goto-char po-start-of-entry) |
| 2006 | (if (re-search-forward rx po-start-of-msgctxt t) |
| 2007 | (list (cons (copy-marker (match-beginning 0)) |
| 2008 | (copy-marker (match-end 0)))) |
| 2009 | nil))) |
| 2010 | |
| 2011 | (defun po-previous-untranslated-regions () |
| 2012 | "Return the list of previous untranslated regions in the current entry." |
| 2013 | (append (po-previous-untranslated-region-for po-any-previous-msgctxt-regexp) |
| 2014 | (po-previous-untranslated-region-for po-any-previous-msgid-regexp) |
| 2015 | (po-previous-untranslated-region-for po-any-previous-msgid_plural-regexp))) |
| 2016 | |
| 2017 | (defun po-delete-previous-untranslated () |
| 2018 | "Delete the previous msgctxt, msgid, msgid_plural fields (marked as #| |
| 2019 | comments) from the current entry." |
| 2020 | (interactive) |
| 2021 | (po-find-span-of-entry) |
| 2022 | (let ((buffer-read-only po-read-only)) |
| 2023 | (dolist (region (po-previous-untranslated-regions)) |
| 2024 | (delete-region (car region) (cdr region)))) |
| 2025 | (po-redisplay)) |
| 2026 | |
| 2027 | (defun po-maybe-delete-previous-untranslated () |
| 2028 | "Delete the previous msgctxt, msgid, msgid_plural fields (marked as #| |
| 2029 | comments) from the current entry, if the user gives the permission." |
| 2030 | (po-find-span-of-entry) |
| 2031 | (let ((previous-regions (po-previous-untranslated-regions))) |
| 2032 | (if previous-regions |
| 2033 | (if (or (eq po-auto-delete-previous-msgid t) |
| 2034 | (and (eq po-auto-delete-previous-msgid 'ask) |
| 2035 | (let ((overlays nil)) |
| 2036 | (unwind-protect |
| 2037 | (progn |
| 2038 | (setq overlays |
| 2039 | (mapcar (function |
| 2040 | (lambda (region) |
| 2041 | (let ((overlay (po-create-overlay))) |
| 2042 | (po-highlight overlay (car region) (cdr region)) |
| 2043 | overlay))) |
| 2044 | previous-regions)) |
| 2045 | ;; Scroll, to show the previous-regions. |
| 2046 | (goto-char (car (car previous-regions))) |
| 2047 | (prog1 (y-or-n-p (_"Delete previous msgid comments? ")) |
| 2048 | (message ""))) |
| 2049 | (mapc 'po-dehighlight overlays))))) |
| 2050 | (let ((buffer-read-only po-read-only)) |
| 2051 | (dolist (region previous-regions) |
| 2052 | (delete-region (car region) (cdr region)))))))) |
| 2053 | |
| 2054 | ;;; Editing management and submode. |
| 2055 | |
| 2056 | ;; In a string edit buffer, BACK-POINTER points to one of the slots of the |
| 2057 | ;; list EDITED-FIELDS kept in the PO buffer. See its description elsewhere. |
| 2058 | ;; Reminder: slots have the form (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO). |
| 2059 | |
| 2060 | (defvar po-subedit-back-pointer) |
| 2061 | |
| 2062 | (defun po-clean-out-killed-edits () |
| 2063 | "From EDITED-FIELDS, clean out any edit having a killed edit buffer." |
| 2064 | (let ((cursor po-edited-fields)) |
| 2065 | (while cursor |
| 2066 | (let ((slot (car cursor))) |
| 2067 | (setq cursor (cdr cursor)) |
| 2068 | (if (buffer-name (nth 1 slot)) |
| 2069 | nil |
| 2070 | (let ((overlay (nth 2 slot))) |
| 2071 | (and overlay (po-dehighlight overlay))) |
| 2072 | (setq po-edited-fields (delete slot po-edited-fields))))))) |
| 2073 | |
| 2074 | (defun po-check-all-pending-edits () |
| 2075 | "Resume any pending edit. Return nil if some remains." |
| 2076 | (po-clean-out-killed-edits) |
| 2077 | (or (null po-edited-fields) |
| 2078 | (let ((slot (car po-edited-fields))) |
| 2079 | (goto-char (nth 0 slot)) |
| 2080 | (pop-to-buffer (nth 1 slot)) |
| 2081 | (message po-subedit-message) |
| 2082 | nil))) |
| 2083 | |
| 2084 | (defun po-check-for-pending-edit (position) |
| 2085 | "Resume any pending edit at POSITION. Return nil if such edit exists." |
| 2086 | (po-clean-out-killed-edits) |
| 2087 | (let ((marker (make-marker))) |
| 2088 | (set-marker marker position) |
| 2089 | (let ((slot (assoc marker po-edited-fields))) |
| 2090 | (if slot |
| 2091 | (progn |
| 2092 | (goto-char marker) |
| 2093 | (pop-to-buffer (nth 1 slot)) |
| 2094 | (message po-subedit-message))) |
| 2095 | (not slot)))) |
| 2096 | |
| 2097 | (defun po-edit-out-full () |
| 2098 | "Get out of PO mode, leaving PO file buffer in fundamental mode." |
| 2099 | (interactive) |
| 2100 | (if (po-check-all-pending-edits) |
| 2101 | ;; Don't ask the user for confirmation, since he has explicitly asked |
| 2102 | ;; for it. |
| 2103 | (progn |
| 2104 | (setq buffer-read-only po-read-only) |
| 2105 | (fundamental-mode) |
| 2106 | (message (_"Type 'M-x po-mode RET' once done"))))) |
| 2107 | |
| 2108 | (defun po-ediff-quit () |
| 2109 | "Quit ediff and exit `recursive-edit'." |
| 2110 | (interactive) |
| 2111 | (ediff-quit t) |
| 2112 | (exit-recursive-edit)) |
| 2113 | |
| 2114 | (add-hook 'ediff-keymap-setup-hook |
| 2115 | '(lambda () |
| 2116 | (define-key ediff-mode-map "Q" 'po-ediff-quit))) |
| 2117 | |
| 2118 | ;; Avoid byte compiler warnings. |
| 2119 | (defvar entry-buffer) |
| 2120 | |
| 2121 | (defun po-ediff-buffers-exit-recursive (b1 b2 oldbuf end) |
| 2122 | "Ediff buffer B1 and B2, pop back to OLDBUF and replace the old variants. |
| 2123 | This function will delete the first two variants in OLDBUF, call |
| 2124 | `ediff-buffers' to compare both strings and replace the two variants in |
| 2125 | OLDBUF with the contents of B2. |
| 2126 | Once done kill B1 and B2. |
| 2127 | |
| 2128 | For more info cf. `po-subedit-ediff'." |
| 2129 | (ediff-buffers b1 b2) |
| 2130 | (recursive-edit) |
| 2131 | (pop-to-buffer oldbuf) |
| 2132 | (delete-region (point-min) end) |
| 2133 | (insert-buffer-substring b2) |
| 2134 | (mapc 'kill-buffer `(,b1 ,b2)) |
| 2135 | (display-buffer entry-buffer t)) |
| 2136 | |
| 2137 | (defun po-subedit-ediff () |
| 2138 | "Edit the subedit buffer using `ediff'. |
| 2139 | `po-subedit-ediff' calls `po-ediff-buffers-exit-recursive' to edit translation |
| 2140 | variants side by side if they are actually different; if variants are equal just |
| 2141 | delete the first one. |
| 2142 | |
| 2143 | `msgcat' is able to produce those variants; every variant is marked with: |
| 2144 | |
| 2145 | #-#-#-#-# file name reference #-#-#-#-# |
| 2146 | |
| 2147 | Put changes in second buffer. |
| 2148 | |
| 2149 | When done with the `ediff' session press \\[exit-recursive-edit] exit to |
| 2150 | `recursive-edit', or call \\[po-ediff-quit] (`Q') in the ediff control panel." |
| 2151 | (interactive) |
| 2152 | (let* ((marker-regex "^#-#-#-#-# \\(.*\\) #-#-#-#-#\n") |
| 2153 | (buf1 " *po-msgstr-1") ; default if first marker is missing |
| 2154 | buf2 start-1 end-1 start-2 end-2 |
| 2155 | (back-pointer po-subedit-back-pointer) |
| 2156 | (entry-marker (nth 0 back-pointer)) |
| 2157 | (entry-buffer (marker-buffer entry-marker))) |
| 2158 | (goto-char (point-min)) |
| 2159 | (if (looking-at marker-regex) |
| 2160 | (and (setq buf1 (match-string-no-properties 1)) |
| 2161 | (forward-line 1))) |
| 2162 | (setq start-1 (point)) |
| 2163 | (if (not (re-search-forward marker-regex (point-max) t)) |
| 2164 | (error "Only 1 msgstr found") |
| 2165 | (setq buf2 (match-string-no-properties 1) |
| 2166 | end-1 (match-beginning 0)) |
| 2167 | (let ((oldbuf (current-buffer))) |
| 2168 | (save-current-buffer |
| 2169 | (set-buffer (get-buffer-create |
| 2170 | (generate-new-buffer-name buf1))) |
| 2171 | (setq buffer-read-only nil) |
| 2172 | (erase-buffer) |
| 2173 | (insert-buffer-substring oldbuf start-1 end-1) |
| 2174 | (setq buffer-read-only t)) |
| 2175 | |
| 2176 | (setq start-2 (point)) |
| 2177 | (save-excursion |
| 2178 | ;; check for a third variant; if found ignore it |
| 2179 | (if (re-search-forward marker-regex (point-max) t) |
| 2180 | (setq end-2 (match-beginning 0)) |
| 2181 | (setq end-2 (goto-char (1- (point-max)))))) |
| 2182 | (save-current-buffer |
| 2183 | (set-buffer (get-buffer-create |
| 2184 | (generate-new-buffer-name buf2))) |
| 2185 | (erase-buffer) |
| 2186 | (insert-buffer-substring oldbuf start-2 end-2)) |
| 2187 | |
| 2188 | (if (not (string-equal (buffer-substring-no-properties start-1 end-1) |
| 2189 | (buffer-substring-no-properties start-2 end-2))) |
| 2190 | (po-ediff-buffers-exit-recursive buf1 buf2 oldbuf end-2) |
| 2191 | (message "Variants are equal; delete %s" buf1) |
| 2192 | (forward-line -1) |
| 2193 | (delete-region (point-min) (point))))))) |
| 2194 | |
| 2195 | (defun po-subedit-abort () |
| 2196 | "Exit the subedit buffer, merely discarding its contents." |
| 2197 | (interactive) |
| 2198 | (let* ((edit-buffer (current-buffer)) |
| 2199 | (back-pointer po-subedit-back-pointer) |
| 2200 | (entry-marker (nth 0 back-pointer)) |
| 2201 | (overlay-info (nth 2 back-pointer)) |
| 2202 | (entry-buffer (marker-buffer entry-marker))) |
| 2203 | (if (null entry-buffer) |
| 2204 | (error (_"Corresponding PO buffer does not exist anymore")) |
| 2205 | (or (one-window-p) (delete-window)) |
| 2206 | (switch-to-buffer entry-buffer) |
| 2207 | (goto-char entry-marker) |
| 2208 | (and overlay-info (po-dehighlight overlay-info)) |
| 2209 | (kill-buffer edit-buffer) |
| 2210 | (setq po-edited-fields (delete back-pointer po-edited-fields))))) |
| 2211 | |
| 2212 | (defun po-subedit-exit () |
| 2213 | "Exit the subedit buffer, replacing the string in the PO buffer." |
| 2214 | (interactive) |
| 2215 | (goto-char (point-max)) |
| 2216 | (skip-chars-backward " \t\n") |
| 2217 | (if (eq (preceding-char) ?<) |
| 2218 | (delete-region (1- (point)) (point-max))) |
| 2219 | (run-hooks 'po-subedit-exit-hook) |
| 2220 | (let ((string (buffer-string))) |
| 2221 | (po-subedit-abort) |
| 2222 | (po-find-span-of-entry) |
| 2223 | (cond ((= (point) po-start-of-msgid) |
| 2224 | (po-set-comment string) |
| 2225 | (po-redisplay)) |
| 2226 | ((= (point) po-start-of-msgstr-form) |
| 2227 | (if (po-set-msgstr-form string) |
| 2228 | (progn |
| 2229 | (po-maybe-delete-previous-untranslated) |
| 2230 | (if (and po-auto-fuzzy-on-edit |
| 2231 | (eq po-entry-type 'translated)) |
| 2232 | (progn |
| 2233 | (po-decrease-type-counter) |
| 2234 | (po-add-attribute "fuzzy") |
| 2235 | (po-current-entry) |
| 2236 | (po-increase-type-counter)))))) |
| 2237 | (t (debug))))) |
| 2238 | |
| 2239 | (defun po-edit-string (string type expand-tabs) |
| 2240 | "Prepare a pop up buffer for editing STRING, which is of a given TYPE. |
| 2241 | TYPE may be 'comment or 'msgstr. If EXPAND-TABS, expand tabs to spaces. |
| 2242 | Run functions on po-subedit-mode-hook." |
| 2243 | (let ((marker (make-marker))) |
| 2244 | (set-marker marker (cond ((eq type 'comment) po-start-of-msgid) |
| 2245 | ((eq type 'msgstr) po-start-of-msgstr-form))) |
| 2246 | (if (po-check-for-pending-edit marker) |
| 2247 | (let ((edit-buffer (generate-new-buffer |
| 2248 | (concat "*" (buffer-name) "*"))) |
| 2249 | (edit-coding buffer-file-coding-system) |
| 2250 | (buffer (current-buffer)) |
| 2251 | overlay slot) |
| 2252 | (if (and (eq type 'msgstr) po-highlighting) |
| 2253 | ;; ;; Try showing all of msgid in the upper window while editing. |
| 2254 | ;; (goto-char (1- po-start-of-msgstr-block)) |
| 2255 | ;; (recenter -1) |
| 2256 | (save-excursion |
| 2257 | (goto-char po-start-of-entry) |
| 2258 | (re-search-forward po-any-msgid-regexp nil t) |
| 2259 | (let ((end (1- (match-end 0)))) |
| 2260 | (goto-char (match-beginning 0)) |
| 2261 | (re-search-forward "msgid +" nil t) |
| 2262 | (setq overlay (po-create-overlay)) |
| 2263 | (po-highlight overlay (point) end buffer)))) |
| 2264 | (setq slot (list marker edit-buffer overlay) |
| 2265 | po-edited-fields (cons slot po-edited-fields)) |
| 2266 | (pop-to-buffer edit-buffer) |
| 2267 | (text-mode) |
| 2268 | (set (make-local-variable 'po-subedit-back-pointer) slot) |
| 2269 | (set (make-local-variable 'indent-line-function) |
| 2270 | 'indent-relative) |
| 2271 | (setq buffer-file-coding-system edit-coding) |
| 2272 | (setq local-abbrev-table po-mode-abbrev-table) |
| 2273 | (erase-buffer) |
| 2274 | (insert string "<") |
| 2275 | (goto-char (point-min)) |
| 2276 | (and expand-tabs (setq indent-tabs-mode nil)) |
| 2277 | (use-local-map po-subedit-mode-map) |
| 2278 | (if (fboundp 'easy-menu-define) |
| 2279 | (easy-menu-define po-subedit-mode-menu po-subedit-mode-map "" |
| 2280 | po-subedit-mode-menu-layout)) |
| 2281 | (set-syntax-table po-subedit-mode-syntax-table) |
| 2282 | (run-hooks 'po-subedit-mode-hook) |
| 2283 | (message po-subedit-message))))) |
| 2284 | |
| 2285 | (defun po-edit-comment () |
| 2286 | "Use another window to edit the current translator comment." |
| 2287 | (interactive) |
| 2288 | (po-find-span-of-entry) |
| 2289 | (po-edit-string (po-get-comment nil) 'comment nil)) |
| 2290 | |
| 2291 | (defun po-edit-comment-and-ediff () |
| 2292 | "Use `ediff' to edit the current translator comment. |
| 2293 | This function calls `po-edit-msgstr' and `po-subedit-ediff'; for more info |
| 2294 | read `po-subedit-ediff' documentation." |
| 2295 | (interactive) |
| 2296 | (po-edit-comment) |
| 2297 | (po-subedit-ediff)) |
| 2298 | |
| 2299 | (defun po-edit-msgstr () |
| 2300 | "Use another window to edit the current msgstr." |
| 2301 | (interactive) |
| 2302 | (po-find-span-of-entry) |
| 2303 | (po-edit-string (if (and po-auto-edit-with-msgid |
| 2304 | (eq po-entry-type 'untranslated)) |
| 2305 | (po-get-msgid) |
| 2306 | (po-get-msgstr-form)) |
| 2307 | 'msgstr |
| 2308 | t)) |
| 2309 | |
| 2310 | (defun po-edit-msgstr-and-ediff () |
| 2311 | "Use `ediff' to edit the current msgstr. |
| 2312 | This function calls `po-edit-msgstr' and `po-subedit-ediff'; for more info |
| 2313 | read `po-subedit-ediff' documentation." |
| 2314 | (interactive) |
| 2315 | (po-edit-msgstr) |
| 2316 | (po-subedit-ediff)) |
| 2317 | \f |
| 2318 | ;;; String normalization and searching. |
| 2319 | |
| 2320 | (defun po-normalize-old-style (explain) |
| 2321 | "Normalize old gettext style fields using K&R C multiline string syntax. |
| 2322 | To minibuffer messages sent while normalizing, add the EXPLAIN string." |
| 2323 | (let ((here (point-marker)) |
| 2324 | (counter 0) |
| 2325 | (buffer-read-only po-read-only)) |
| 2326 | (goto-char (point-min)) |
| 2327 | (message (_"Normalizing %d, %s") counter explain) |
| 2328 | (while (re-search-forward |
| 2329 | "\\(^#?[ \t]*msg\\(id\\|str\\)[ \t]*\"\\|[^\" \t][ \t]*\\)\\\\\n" |
| 2330 | nil t) |
| 2331 | (if (= (% counter 10) 0) |
| 2332 | (message (_"Normalizing %d, %s") counter explain)) |
| 2333 | (replace-match "\\1\"\n\"" t nil) |
| 2334 | (setq counter (1+ counter))) |
| 2335 | (goto-char here) |
| 2336 | (message (_"Normalizing %d...done") counter))) |
| 2337 | |
| 2338 | (defun po-normalize-field (field explain) |
| 2339 | "Normalize FIELD of all entries. FIELD is either the symbol msgid or msgstr. |
| 2340 | To minibuffer messages sent while normalizing, add the EXPLAIN string." |
| 2341 | (let ((here (point-marker)) |
| 2342 | (counter 0)) |
| 2343 | (goto-char (point-min)) |
| 2344 | (while (re-search-forward po-any-msgstr-block-regexp nil t) |
| 2345 | (if (= (% counter 10) 0) |
| 2346 | (message (_"Normalizing %d, %s") counter explain)) |
| 2347 | (goto-char (match-beginning 0)) |
| 2348 | (po-find-span-of-entry) |
| 2349 | (cond ((eq field 'msgid) (po-set-msgid (po-get-msgid))) |
| 2350 | ((eq field 'msgstr) (po-set-msgstr-form (po-get-msgstr-form)))) |
| 2351 | (goto-char po-end-of-entry) |
| 2352 | (setq counter (1+ counter))) |
| 2353 | (goto-char here) |
| 2354 | (message (_"Normalizing %d...done") counter))) |
| 2355 | |
| 2356 | ;; Normalize, but the British way! :-) |
| 2357 | (defsubst po-normalise () (po-normalize)) |
| 2358 | |
| 2359 | (defun po-normalize () |
| 2360 | "Normalize all entries in the PO file." |
| 2361 | (interactive) |
| 2362 | (po-normalize-old-style (_"pass 1/3")) |
| 2363 | ;; FIXME: This cannot work: t and nil are not msgid and msgstr. |
| 2364 | (po-normalize-field t (_"pass 2/3")) |
| 2365 | (po-normalize-field nil (_"pass 3/3")) |
| 2366 | ;; The last PO file entry has just been processed. |
| 2367 | (if (not (= po-end-of-entry (point-max))) |
| 2368 | (let ((buffer-read-only po-read-only)) |
| 2369 | (kill-region po-end-of-entry (point-max)))) |
| 2370 | ;; A bizarre format might have fooled the counters, so recompute |
| 2371 | ;; them to make sure their value is dependable. |
| 2372 | (po-compute-counters nil)) |
| 2373 | \f |
| 2374 | ;;; Multiple PO files. |
| 2375 | |
| 2376 | (defun po-show-auxiliary-list () |
| 2377 | "Echo the current auxiliary list in the message area." |
| 2378 | (if po-auxiliary-list |
| 2379 | (let ((cursor po-auxiliary-cursor) |
| 2380 | string) |
| 2381 | (while cursor |
| 2382 | (setq string (concat string (if string " ") (car (car cursor))) |
| 2383 | cursor (cdr cursor))) |
| 2384 | (setq cursor po-auxiliary-list) |
| 2385 | (while (not (eq cursor po-auxiliary-cursor)) |
| 2386 | (setq string (concat string (if string " ") (car (car cursor))) |
| 2387 | cursor (cdr cursor))) |
| 2388 | (message string)) |
| 2389 | (message (_"No auxiliary files.")))) |
| 2390 | |
| 2391 | (defun po-consider-as-auxiliary () |
| 2392 | "Add the current PO file to the list of auxiliary files." |
| 2393 | (interactive) |
| 2394 | (if (member (list buffer-file-name) po-auxiliary-list) |
| 2395 | nil |
| 2396 | (setq po-auxiliary-list |
| 2397 | (nconc po-auxiliary-list (list (list buffer-file-name)))) |
| 2398 | (or po-auxiliary-cursor |
| 2399 | (setq po-auxiliary-cursor po-auxiliary-list))) |
| 2400 | (po-show-auxiliary-list)) |
| 2401 | |
| 2402 | (defun po-ignore-as-auxiliary () |
| 2403 | "Delete the current PO file from the list of auxiliary files." |
| 2404 | (interactive) |
| 2405 | (setq po-auxiliary-list (delete (list buffer-file-name) po-auxiliary-list) |
| 2406 | po-auxiliary-cursor po-auxiliary-list) |
| 2407 | (po-show-auxiliary-list)) |
| 2408 | |
| 2409 | (defun po-seek-equivalent-translation (name string) |
| 2410 | "Search a PO file NAME for a 'msgid' STRING having a non-empty 'msgstr'. |
| 2411 | STRING is the full quoted msgid field, including the 'msgid' keyword. When |
| 2412 | found, display the file over the current window, with the 'msgstr' field |
| 2413 | possibly highlighted, the cursor at start of msgid, then return 't'. |
| 2414 | Otherwise, move nothing, and just return 'nil'." |
| 2415 | (let ((current (current-buffer)) |
| 2416 | (buffer (find-file-noselect name))) |
| 2417 | (set-buffer buffer) |
| 2418 | (let ((start (point)) |
| 2419 | found) |
| 2420 | (goto-char (point-min)) |
| 2421 | (while (and (not found) (search-forward string nil t)) |
| 2422 | ;; Screen out longer 'msgid's. |
| 2423 | (if (looking-at "^msgstr ") |
| 2424 | (progn |
| 2425 | (po-find-span-of-entry) |
| 2426 | ;; Ignore an untranslated entry. |
| 2427 | (or (string-equal |
| 2428 | (buffer-substring po-start-of-msgstr-block po-end-of-entry) |
| 2429 | "msgstr \"\"\n") |
| 2430 | (setq found t))))) |
| 2431 | (if found |
| 2432 | (progn |
| 2433 | (switch-to-buffer buffer) |
| 2434 | (po-find-span-of-entry) |
| 2435 | (if po-highlighting |
| 2436 | (progn |
| 2437 | (goto-char po-start-of-entry) |
| 2438 | (re-search-forward po-any-msgstr-block-regexp nil t) |
| 2439 | (let ((end (1- (match-end 0)))) |
| 2440 | (goto-char (match-beginning 0)) |
| 2441 | (re-search-forward "msgstr +" nil t) |
| 2442 | ;; Just "borrow" the marking overlay. |
| 2443 | (po-highlight po-marking-overlay (point) end)))) |
| 2444 | (goto-char po-start-of-msgid)) |
| 2445 | (goto-char start) |
| 2446 | (po-find-span-of-entry) |
| 2447 | (set-buffer current)) |
| 2448 | found))) |
| 2449 | |
| 2450 | (defun po-cycle-auxiliary () |
| 2451 | "Select the next auxiliary file having an entry with same 'msgid'." |
| 2452 | (interactive) |
| 2453 | (po-find-span-of-entry) |
| 2454 | (if po-auxiliary-list |
| 2455 | (let ((string (buffer-substring po-start-of-msgid |
| 2456 | po-start-of-msgstr-block)) |
| 2457 | (cursor po-auxiliary-cursor) |
| 2458 | found name) |
| 2459 | (while (and (not found) cursor) |
| 2460 | (setq name (car (car cursor))) |
| 2461 | (if (and (not (string-equal buffer-file-name name)) |
| 2462 | (po-seek-equivalent-translation name string)) |
| 2463 | (setq found t |
| 2464 | po-auxiliary-cursor cursor)) |
| 2465 | (setq cursor (cdr cursor))) |
| 2466 | (setq cursor po-auxiliary-list) |
| 2467 | (while (and (not found) cursor) |
| 2468 | (setq name (car (car cursor))) |
| 2469 | (if (and (not (string-equal buffer-file-name name)) |
| 2470 | (po-seek-equivalent-translation name string)) |
| 2471 | (setq found t |
| 2472 | po-auxiliary-cursor cursor)) |
| 2473 | (setq cursor (cdr cursor))) |
| 2474 | (or found (message (_"No other translation found"))) |
| 2475 | found))) |
| 2476 | |
| 2477 | (defun po-subedit-cycle-auxiliary () |
| 2478 | "Cycle auxiliary file, but from the translation edit buffer." |
| 2479 | (interactive) |
| 2480 | (let* ((entry-marker (nth 0 po-subedit-back-pointer)) |
| 2481 | (entry-buffer (marker-buffer entry-marker)) |
| 2482 | (buffer (current-buffer))) |
| 2483 | (pop-to-buffer entry-buffer) |
| 2484 | (po-cycle-auxiliary) |
| 2485 | (pop-to-buffer buffer))) |
| 2486 | |
| 2487 | (defun po-select-auxiliary () |
| 2488 | "Select one of the available auxiliary files and locate an equivalent entry. |
| 2489 | If an entry having the same 'msgid' cannot be found, merely select the file |
| 2490 | without moving its cursor." |
| 2491 | (interactive) |
| 2492 | (po-find-span-of-entry) |
| 2493 | (if po-auxiliary-list |
| 2494 | (let ((string |
| 2495 | (buffer-substring po-start-of-msgid po-start-of-msgstr-block)) |
| 2496 | (name (car (assoc (completing-read (_"Which auxiliary file? ") |
| 2497 | po-auxiliary-list nil t) |
| 2498 | po-auxiliary-list)))) |
| 2499 | (po-consider-as-auxiliary) |
| 2500 | (or (po-seek-equivalent-translation name string) |
| 2501 | (find-file name))))) |
| 2502 | \f |
| 2503 | ;;; Original program sources as context. |
| 2504 | |
| 2505 | (defun po-show-source-path () |
| 2506 | "Echo the current source search path in the message area." |
| 2507 | (if po-search-path |
| 2508 | (let ((cursor po-search-path) |
| 2509 | string) |
| 2510 | (while cursor |
| 2511 | (setq string (concat string (if string " ") (car (car cursor))) |
| 2512 | cursor (cdr cursor))) |
| 2513 | (message string)) |
| 2514 | (message (_"Empty source path.")))) |
| 2515 | |
| 2516 | (defun po-consider-source-path (directory) |
| 2517 | "Add a given DIRECTORY, requested interactively, to the source search path." |
| 2518 | (interactive "DDirectory for search path: ") |
| 2519 | (setq po-search-path (cons (list (if (string-match "/$" directory) |
| 2520 | directory |
| 2521 | (concat directory "/"))) |
| 2522 | po-search-path)) |
| 2523 | (setq po-reference-check 0) |
| 2524 | (po-show-source-path)) |
| 2525 | |
| 2526 | (defun po-ignore-source-path () |
| 2527 | "Delete a directory, selected with completion, from the source search path." |
| 2528 | (interactive) |
| 2529 | (setq po-search-path |
| 2530 | (delete (list (completing-read (_"Directory to remove? ") |
| 2531 | po-search-path nil t)) |
| 2532 | po-search-path)) |
| 2533 | (setq po-reference-check 0) |
| 2534 | (po-show-source-path)) |
| 2535 | |
| 2536 | (defun po-ensure-source-references () |
| 2537 | "Extract all references into a list, with paths resolved, if necessary." |
| 2538 | (po-find-span-of-entry) |
| 2539 | (if (= po-start-of-entry po-reference-check) |
| 2540 | nil |
| 2541 | (setq po-reference-alist nil) |
| 2542 | (save-excursion |
| 2543 | (goto-char po-start-of-entry) |
| 2544 | (if (re-search-forward "^#:" po-start-of-msgid t) |
| 2545 | (let (current name line path file) |
| 2546 | (while (looking-at "\\(\n#:\\)? *\\([^: ]*\\):\\([0-9]+\\)") |
| 2547 | (goto-char (match-end 0)) |
| 2548 | (setq name (po-match-string 2) |
| 2549 | line (po-match-string 3) |
| 2550 | path po-search-path) |
| 2551 | (if (string-equal name "") |
| 2552 | nil |
| 2553 | (while (and (not (file-exists-p |
| 2554 | (setq file (concat (car (car path)) name)))) |
| 2555 | path) |
| 2556 | (setq path (cdr path))) |
| 2557 | (setq current (and path file))) |
| 2558 | (if current |
| 2559 | (setq po-reference-alist |
| 2560 | (cons (list (concat current ":" line) |
| 2561 | current |
| 2562 | (string-to-number line)) |
| 2563 | po-reference-alist))))))) |
| 2564 | (setq po-reference-alist (nreverse po-reference-alist) |
| 2565 | po-reference-cursor po-reference-alist |
| 2566 | po-reference-check po-start-of-entry))) |
| 2567 | |
| 2568 | (defun po-show-source-context (triplet) |
| 2569 | "Show the source context given a TRIPLET which is (PROMPT FILE LINE)." |
| 2570 | (find-file-other-window (car (cdr triplet))) |
| 2571 | (goto-line (car (cdr (cdr triplet)))) |
| 2572 | (other-window 1) |
| 2573 | (let ((maximum 0) |
| 2574 | position |
| 2575 | (cursor po-reference-alist)) |
| 2576 | (while (not (eq triplet (car cursor))) |
| 2577 | (setq maximum (1+ maximum) |
| 2578 | cursor (cdr cursor))) |
| 2579 | (setq position (1+ maximum) |
| 2580 | po-reference-cursor cursor) |
| 2581 | (while cursor |
| 2582 | (setq maximum (1+ maximum) |
| 2583 | cursor (cdr cursor))) |
| 2584 | (message (_"Displaying %d/%d: \"%s\"") position maximum (car triplet)))) |
| 2585 | |
| 2586 | (defun po-cycle-source-reference () |
| 2587 | "Display some source context for the current entry. |
| 2588 | If the command is repeated many times in a row, cycle through contexts." |
| 2589 | (interactive) |
| 2590 | (po-ensure-source-references) |
| 2591 | (if po-reference-cursor |
| 2592 | (po-show-source-context |
| 2593 | (car (if (eq last-command 'po-cycle-source-reference) |
| 2594 | (or (cdr po-reference-cursor) po-reference-alist) |
| 2595 | po-reference-cursor))) |
| 2596 | (error (_"No resolved source references")))) |
| 2597 | |
| 2598 | (defun po-select-source-reference () |
| 2599 | "Select one of the available source contexts for the current entry." |
| 2600 | (interactive) |
| 2601 | (po-ensure-source-references) |
| 2602 | (if po-reference-alist |
| 2603 | (po-show-source-context |
| 2604 | (assoc |
| 2605 | (completing-read (_"Which source context? ") po-reference-alist nil t) |
| 2606 | po-reference-alist)) |
| 2607 | (error (_"No resolved source references")))) |
| 2608 | \f |
| 2609 | ;;; String marking in program sources, through TAGS table. |
| 2610 | |
| 2611 | ;; Globally defined within tags.el. |
| 2612 | (defvar tags-loop-operate) |
| 2613 | (defvar tags-loop-scan) |
| 2614 | |
| 2615 | ;; Locally set in each program source buffer. |
| 2616 | (defvar po-find-string-function) |
| 2617 | (defvar po-mark-string-function) |
| 2618 | |
| 2619 | ;; Dynamically set within po-tags-search for po-tags-loop-operate. |
| 2620 | (defvar po-current-po-buffer) |
| 2621 | (defvar po-current-po-keywords) |
| 2622 | |
| 2623 | (defun po-tags-search (restart) |
| 2624 | "Find an unmarked translatable string through all files in tags table. |
| 2625 | Disregard some simple strings which are most probably non-translatable. |
| 2626 | With prefix argument, restart search at first file." |
| 2627 | (interactive "P") |
| 2628 | (require 'etags) |
| 2629 | ;; Ensure there is no highlighting, in case the search fails. |
| 2630 | (if po-highlighting |
| 2631 | (po-dehighlight po-marking-overlay)) |
| 2632 | (setq po-string-contents nil) |
| 2633 | ;; Search for a string which might later be marked for translation. |
| 2634 | (let ((po-current-po-buffer (current-buffer)) |
| 2635 | (po-current-po-keywords po-keywords)) |
| 2636 | (pop-to-buffer po-string-buffer) |
| 2637 | (if (and (not restart) |
| 2638 | (eq (car tags-loop-operate) 'po-tags-loop-operate)) |
| 2639 | ;; Continue last po-tags-search. |
| 2640 | (tags-loop-continue nil) |
| 2641 | ;; Start or restart po-tags-search all over. |
| 2642 | (setq tags-loop-scan '(po-tags-loop-scan) |
| 2643 | tags-loop-operate '(po-tags-loop-operate)) |
| 2644 | (tags-loop-continue t)) |
| 2645 | (select-window (get-buffer-window po-current-po-buffer))) |
| 2646 | (if po-string-contents |
| 2647 | (let ((window (selected-window)) |
| 2648 | (buffer po-string-buffer) |
| 2649 | (start po-string-start) |
| 2650 | (end po-string-end)) |
| 2651 | ;; Try to fit the string in the displayed part of its window. |
| 2652 | (select-window (get-buffer-window buffer)) |
| 2653 | (goto-char start) |
| 2654 | (or (pos-visible-in-window-p start) |
| 2655 | (recenter '(nil))) |
| 2656 | (if (pos-visible-in-window-p end) |
| 2657 | (goto-char end) |
| 2658 | (goto-char end) |
| 2659 | (recenter -1)) |
| 2660 | (select-window window) |
| 2661 | ;; Highlight the string as found. |
| 2662 | (and po-highlighting |
| 2663 | (po-highlight po-marking-overlay start end buffer))))) |
| 2664 | |
| 2665 | (defun po-tags-loop-scan () |
| 2666 | "Decide if the current buffer is still interesting for PO mode strings." |
| 2667 | ;; We have little choice, here. The major mode is needed to dispatch to the |
| 2668 | ;; proper scanner, so we declare all files as interesting, to force Emacs |
| 2669 | ;; tags module to revisit files fully. po-tags-loop-operate sets point at |
| 2670 | ;; end of buffer when it is done with a file. |
| 2671 | (not (eobp))) |
| 2672 | |
| 2673 | (defun po-tags-loop-operate () |
| 2674 | "Find an acceptable tag in the current buffer, according to mode. |
| 2675 | Disregard some simple strings which are most probably non-translatable." |
| 2676 | (po-preset-string-functions) |
| 2677 | (let ((continue t) |
| 2678 | data) |
| 2679 | (while continue |
| 2680 | (setq data (apply po-find-string-function po-current-po-keywords nil)) |
| 2681 | (if data |
| 2682 | ;; Push the string just found into a work buffer for study. |
| 2683 | (po-with-temp-buffer |
| 2684 | (insert (nth 0 data)) |
| 2685 | (goto-char (point-min)) |
| 2686 | ;; Accept if at least three letters in a row. |
| 2687 | (if (re-search-forward "[A-Za-z][A-Za-z][A-Za-z]" nil t) |
| 2688 | (setq continue nil) |
| 2689 | ;; Disregard if single letters or no letters at all. |
| 2690 | (if (re-search-forward "[A-Za-z][A-Za-z]" nil t) |
| 2691 | ;; Here, we have two letters in a row, but never more. |
| 2692 | ;; Accept only if more letters than punctuations. |
| 2693 | (let ((total (buffer-size))) |
| 2694 | (goto-char (point-min)) |
| 2695 | (while (re-search-forward "[A-Za-z]+" nil t) |
| 2696 | (replace-match "" t t)) |
| 2697 | (if (< (* 2 (buffer-size)) total) |
| 2698 | (setq continue nil)))))) |
| 2699 | ;; No string left in this buffer. |
| 2700 | (setq continue nil))) |
| 2701 | (if data |
| 2702 | ;; Save information for marking functions. |
| 2703 | (let ((buffer (current-buffer))) |
| 2704 | (save-excursion |
| 2705 | (set-buffer po-current-po-buffer) |
| 2706 | (setq po-string-contents (nth 0 data) |
| 2707 | po-string-buffer buffer |
| 2708 | po-string-start (nth 1 data) |
| 2709 | po-string-end (nth 2 data)))) |
| 2710 | (goto-char (point-max))) |
| 2711 | ;; If nothing was found, trigger scanning of next file. |
| 2712 | (not data))) |
| 2713 | |
| 2714 | (defun po-mark-found-string (keyword) |
| 2715 | "Mark last found string in program sources as translatable, using KEYWORD." |
| 2716 | (if (not po-string-contents) |
| 2717 | (error (_"No such string"))) |
| 2718 | (and po-highlighting (po-dehighlight po-marking-overlay)) |
| 2719 | (let ((contents po-string-contents) |
| 2720 | (buffer po-string-buffer) |
| 2721 | (start po-string-start) |
| 2722 | (end po-string-end) |
| 2723 | line string) |
| 2724 | ;; Mark string in program sources. |
| 2725 | (save-excursion |
| 2726 | (set-buffer buffer) |
| 2727 | (setq line (count-lines (point-min) start)) |
| 2728 | (apply po-mark-string-function start end keyword nil)) |
| 2729 | ;; Add PO file entry. |
| 2730 | (let ((buffer-read-only po-read-only)) |
| 2731 | (goto-char (point-max)) |
| 2732 | (insert "\n" (format "#: %s:%d\n" |
| 2733 | (buffer-file-name po-string-buffer) |
| 2734 | line)) |
| 2735 | (save-excursion |
| 2736 | (insert (po-eval-requoted contents "msgid" nil) "msgstr \"\"\n")) |
| 2737 | (setq po-untranslated-counter (1+ po-untranslated-counter)) |
| 2738 | (po-update-mode-line-string)) |
| 2739 | (setq po-string-contents nil))) |
| 2740 | |
| 2741 | (defun po-mark-translatable () |
| 2742 | "Mark last found string in program sources as translatable, using '_'." |
| 2743 | (interactive) |
| 2744 | (po-mark-found-string "_")) |
| 2745 | |
| 2746 | (defun po-select-mark-and-mark (arg) |
| 2747 | "Mark last found string in program sources as translatable, ask for keyword, |
| 2748 | using completion. With prefix argument, just ask the name of a preferred |
| 2749 | keyword for subsequent commands, also added to possible completions." |
| 2750 | (interactive "P") |
| 2751 | (if arg |
| 2752 | (let ((keyword (list (read-from-minibuffer (_"Keyword: "))))) |
| 2753 | (setq po-keywords (cons keyword (delete keyword po-keywords)))) |
| 2754 | (or po-string-contents (error (_"No such string"))) |
| 2755 | (let* ((default (car (car po-keywords))) |
| 2756 | (keyword (completing-read (format (_"Mark with keyword? [%s] ") |
| 2757 | default) |
| 2758 | po-keywords nil t ))) |
| 2759 | (if (string-equal keyword "") (setq keyword default)) |
| 2760 | (po-mark-found-string keyword)))) |
| 2761 | \f |
| 2762 | ;;; Unknown mode specifics. |
| 2763 | |
| 2764 | (defun po-preset-string-functions () |
| 2765 | "Preset FIND-STRING-FUNCTION and MARK-STRING-FUNCTION according to mode. |
| 2766 | These variables are locally set in source buffer only when not already bound." |
| 2767 | (let ((pair (cond ((equal major-mode 'awk-mode) |
| 2768 | '(po-find-awk-string . po-mark-awk-string)) |
| 2769 | ((member major-mode '(c-mode c++-mode)) |
| 2770 | '(po-find-c-string . po-mark-c-string)) |
| 2771 | ((equal major-mode 'emacs-lisp-mode) |
| 2772 | '(po-find-emacs-lisp-string . po-mark-emacs-lisp-string)) |
| 2773 | ((equal major-mode 'python-mode) |
| 2774 | '(po-find-python-string . po-mark-python-string)) |
| 2775 | ((and (equal major-mode 'sh-mode) |
| 2776 | (string-equal mode-line-process "[bash]")) |
| 2777 | '(po-find-bash-string . po-mark-bash-string)) |
| 2778 | (t '(po-find-unknown-string . po-mark-unknown-string))))) |
| 2779 | (or (boundp 'po-find-string-function) |
| 2780 | (set (make-local-variable 'po-find-string-function) (car pair))) |
| 2781 | (or (boundp 'po-mark-string-function) |
| 2782 | (set (make-local-variable 'po-mark-string-function) (cdr pair))))) |
| 2783 | |
| 2784 | (defun po-find-unknown-string (keywords) |
| 2785 | "Dummy function to skip over a file, finding no string in it." |
| 2786 | nil) |
| 2787 | |
| 2788 | (defun po-mark-unknown-string (start end keyword) |
| 2789 | "Dummy function to mark a given string. May not be called." |
| 2790 | (error (_"Dummy function called"))) |
| 2791 | \f |
| 2792 | ;;; Awk mode specifics. |
| 2793 | |
| 2794 | (defun po-find-awk-string (keywords) |
| 2795 | "Find the next Awk string, excluding those marked by any of KEYWORDS. |
| 2796 | Return (CONTENTS START END) for the found string, or nil if none found." |
| 2797 | (let (start end) |
| 2798 | (while (and (not start) |
| 2799 | (re-search-forward "[#/\"]" nil t)) |
| 2800 | (cond ((= (preceding-char) ?#) |
| 2801 | ;; Disregard comments. |
| 2802 | (or (search-forward "\n" nil t) |
| 2803 | (goto-char (point-max)))) |
| 2804 | ((= (preceding-char) ?/) |
| 2805 | ;; Skip regular expressions. |
| 2806 | (while (not (= (following-char) ?/)) |
| 2807 | (skip-chars-forward "^/\\\\") |
| 2808 | (if (= (following-char) ?\\) (forward-char 2))) |
| 2809 | (forward-char 1)) |
| 2810 | ;; Else find the end of the string. |
| 2811 | (t (setq start (1- (point))) |
| 2812 | (while (not (= (following-char) ?\")) |
| 2813 | (skip-chars-forward "^\"\\\\") |
| 2814 | (if (= (following-char) ?\\) (forward-char 2))) |
| 2815 | (forward-char 1) |
| 2816 | (setq end (point)) |
| 2817 | ;; Check before string either for underline, or for keyword |
| 2818 | ;; and opening parenthesis. |
| 2819 | (save-excursion |
| 2820 | (goto-char start) |
| 2821 | (cond ((= (preceding-char) ?_) |
| 2822 | ;; Disregard already marked strings. |
| 2823 | (setq start nil |
| 2824 | end nil)) |
| 2825 | ((= (preceding-char) ?\() |
| 2826 | (backward-char 1) |
| 2827 | (let ((end-keyword (point))) |
| 2828 | (skip-chars-backward "_A-Za-z0-9") |
| 2829 | (if (member (list (po-buffer-substring |
| 2830 | (point) end-keyword)) |
| 2831 | keywords) |
| 2832 | ;; Disregard already marked strings. |
| 2833 | (setq start nil |
| 2834 | end nil))))))))) |
| 2835 | (and start end |
| 2836 | (list (po-extract-unquoted (current-buffer) start end) start end)))) |
| 2837 | |
| 2838 | (defun po-mark-awk-string (start end keyword) |
| 2839 | "Mark the Awk string, from START to END, with KEYWORD. |
| 2840 | Leave point after marked string." |
| 2841 | (if (string-equal keyword "_") |
| 2842 | (progn |
| 2843 | (goto-char start) |
| 2844 | (insert "_") |
| 2845 | (goto-char (1+ end))) |
| 2846 | (goto-char end) |
| 2847 | (insert ")") |
| 2848 | (save-excursion |
| 2849 | (goto-char start) |
| 2850 | (insert keyword "(")))) |
| 2851 | \f |
| 2852 | ;;; Bash mode specifics. |
| 2853 | |
| 2854 | (defun po-find-bash-string (keywords) |
| 2855 | "Find the next unmarked Bash string. KEYWORDS are merely ignored. |
| 2856 | Return (CONTENTS START END) for the found string, or nil if none found." |
| 2857 | (let (start end) |
| 2858 | (while (and (not start) |
| 2859 | (re-search-forward "[#'\"]" nil t)) |
| 2860 | (cond ((= (preceding-char) ?#) |
| 2861 | ;; Disregard comments. |
| 2862 | (or (search-forward "\n" nil t) |
| 2863 | (goto-char (point-max)))) |
| 2864 | ((= (preceding-char) ?') |
| 2865 | ;; Skip single quoted strings. |
| 2866 | (while (not (= (following-char) ?')) |
| 2867 | (skip-chars-forward "^'\\\\") |
| 2868 | (if (= (following-char) ?\\) (forward-char 2))) |
| 2869 | (forward-char 1)) |
| 2870 | ;; Else find the end of the double quoted string. |
| 2871 | (t (setq start (1- (point))) |
| 2872 | (while (not (= (following-char) ?\")) |
| 2873 | (skip-chars-forward "^\"\\\\") |
| 2874 | (if (= (following-char) ?\\) (forward-char 2))) |
| 2875 | (forward-char 1) |
| 2876 | (setq end (point)) |
| 2877 | ;; Check before string for dollar sign. |
| 2878 | (save-excursion |
| 2879 | (goto-char start) |
| 2880 | (if (= (preceding-char) ?$) |
| 2881 | ;; Disregard already marked strings. |
| 2882 | (setq start nil |
| 2883 | end nil)))))) |
| 2884 | (and start end |
| 2885 | (list (po-extract-unquoted (current-buffer) start end) start end)))) |
| 2886 | |
| 2887 | (defun po-mark-bash-string (start end keyword) |
| 2888 | "Mark the Bash string, from START to END, with '$'. KEYWORD is ignored. |
| 2889 | Leave point after marked string." |
| 2890 | (goto-char start) |
| 2891 | (insert "$") |
| 2892 | (goto-char (1+ end))) |
| 2893 | \f |
| 2894 | ;;; C or C++ mode specifics. |
| 2895 | |
| 2896 | ;;; A few long string cases (submitted by Ben Pfaff). |
| 2897 | |
| 2898 | ;; #define string "This is a long string " \ |
| 2899 | ;; "that is continued across several lines " \ |
| 2900 | ;; "in a macro in order to test \\ quoting\\" \ |
| 2901 | ;; "\\ with goofy strings.\\" |
| 2902 | |
| 2903 | ;; char *x = "This is just an ordinary string " |
| 2904 | ;; "continued across several lines without needing " |
| 2905 | ;; "to use \\ characters at end-of-line."; |
| 2906 | |
| 2907 | ;; char *y = "Here is a string continued across \ |
| 2908 | ;; several lines in the manner that was sanctioned \ |
| 2909 | ;; in K&R C compilers and still works today, \ |
| 2910 | ;; even though the method used above is more esthetic."; |
| 2911 | |
| 2912 | ;;; End of long string cases. |
| 2913 | |
| 2914 | (defun po-find-c-string (keywords) |
| 2915 | "Find the next C string, excluding those marked by any of KEYWORDS. |
| 2916 | Returns (CONTENTS START END) for the found string, or nil if none found." |
| 2917 | (let (start end) |
| 2918 | (while (and (not start) |
| 2919 | (re-search-forward "\\([\"']\\|/\\*\\|//\\)" nil t)) |
| 2920 | (cond ((= (preceding-char) ?*) |
| 2921 | ;; Disregard comments. |
| 2922 | (search-forward "*/")) |
| 2923 | ((= (preceding-char) ?/) |
| 2924 | ;; Disregard C++ comments. |
| 2925 | (end-of-line) |
| 2926 | (forward-char 1)) |
| 2927 | ((= (preceding-char) ?\') |
| 2928 | ;; Disregard character constants. |
| 2929 | (forward-char (if (= (following-char) ?\\) 3 2))) |
| 2930 | ((save-excursion |
| 2931 | (beginning-of-line) |
| 2932 | (looking-at "^# *\\(include\\|line\\)")) |
| 2933 | ;; Disregard lines being #include or #line directives. |
| 2934 | (end-of-line)) |
| 2935 | ;; Else, find the end of the (possibly concatenated) string. |
| 2936 | (t (setq start (1- (point)) |
| 2937 | end nil) |
| 2938 | (while (not end) |
| 2939 | (cond ((= (following-char) ?\") |
| 2940 | (if (looking-at "\"[ \t\n\\\\]*\"") |
| 2941 | (goto-char (match-end 0)) |
| 2942 | (forward-char 1) |
| 2943 | (setq end (point)))) |
| 2944 | ((= (following-char) ?\\) (forward-char 2)) |
| 2945 | (t (skip-chars-forward "^\"\\\\")))) |
| 2946 | ;; Check before string for keyword and opening parenthesis. |
| 2947 | (goto-char start) |
| 2948 | (skip-chars-backward " \n\t") |
| 2949 | (if (= (preceding-char) ?\() |
| 2950 | (progn |
| 2951 | (backward-char 1) |
| 2952 | (skip-chars-backward " \n\t") |
| 2953 | (let ((end-keyword (point))) |
| 2954 | (skip-chars-backward "_A-Za-z0-9") |
| 2955 | (if (member (list (po-buffer-substring (point) |
| 2956 | end-keyword)) |
| 2957 | keywords) |
| 2958 | ;; Disregard already marked strings. |
| 2959 | (progn |
| 2960 | (goto-char end) |
| 2961 | (setq start nil |
| 2962 | end nil)) |
| 2963 | ;; String found. Prepare to resume search. |
| 2964 | (goto-char end)))) |
| 2965 | ;; String found. Prepare to resume search. |
| 2966 | (goto-char end))))) |
| 2967 | ;; Return the found string, if any. |
| 2968 | (and start end |
| 2969 | (list (po-extract-unquoted (current-buffer) start end) start end)))) |
| 2970 | |
| 2971 | (defun po-mark-c-string (start end keyword) |
| 2972 | "Mark the C string, from START to END, with KEYWORD. |
| 2973 | Leave point after marked string." |
| 2974 | (goto-char end) |
| 2975 | (insert ")") |
| 2976 | (save-excursion |
| 2977 | (goto-char start) |
| 2978 | (insert keyword) |
| 2979 | (or (string-equal keyword "_") (insert " ")) |
| 2980 | (insert "("))) |
| 2981 | \f |
| 2982 | ;;; Emacs LISP mode specifics. |
| 2983 | |
| 2984 | (defun po-find-emacs-lisp-string (keywords) |
| 2985 | "Find the next Emacs LISP string, excluding those marked by any of KEYWORDS. |
| 2986 | Returns (CONTENTS START END) for the found string, or nil if none found." |
| 2987 | (let (start end) |
| 2988 | (while (and (not start) |
| 2989 | (re-search-forward "[;\"?]" nil t)) |
| 2990 | (cond ((= (preceding-char) ?\;) |
| 2991 | ;; Disregard comments. |
| 2992 | (search-forward "\n")) |
| 2993 | ((= (preceding-char) ?\?) |
| 2994 | ;; Disregard character constants. |
| 2995 | (forward-char (if (= (following-char) ?\\) 2 1))) |
| 2996 | ;; Else, find the end of the string. |
| 2997 | (t (setq start (1- (point))) |
| 2998 | (while (not (= (following-char) ?\")) |
| 2999 | (skip-chars-forward "^\"\\\\") |
| 3000 | (if (= (following-char) ?\\) (forward-char 2))) |
| 3001 | (forward-char 1) |
| 3002 | (setq end (point)) |
| 3003 | ;; Check before string for keyword and opening parenthesis. |
| 3004 | (goto-char start) |
| 3005 | (skip-chars-backward " \n\t") |
| 3006 | (let ((end-keyword (point))) |
| 3007 | (skip-chars-backward "-_A-Za-z0-9") |
| 3008 | (if (and (= (preceding-char) ?\() |
| 3009 | (member (list (po-buffer-substring (point) |
| 3010 | end-keyword)) |
| 3011 | keywords)) |
| 3012 | ;; Disregard already marked strings. |
| 3013 | (progn |
| 3014 | (goto-char end) |
| 3015 | (setq start nil |
| 3016 | end nil))))))) |
| 3017 | ;; Return the found string, if any. |
| 3018 | (and start end |
| 3019 | (list (po-extract-unquoted (current-buffer) start end) start end)))) |
| 3020 | |
| 3021 | (defun po-mark-emacs-lisp-string (start end keyword) |
| 3022 | "Mark the Emacs LISP string, from START to END, with KEYWORD. |
| 3023 | Leave point after marked string." |
| 3024 | (goto-char end) |
| 3025 | (insert ")") |
| 3026 | (save-excursion |
| 3027 | (goto-char start) |
| 3028 | (insert "(" keyword) |
| 3029 | (or (string-equal keyword "_") (insert " ")))) |
| 3030 | \f |
| 3031 | ;;; Python mode specifics. |
| 3032 | |
| 3033 | (defun po-find-python-string (keywords) |
| 3034 | "Find the next Python string, excluding those marked by any of KEYWORDS. |
| 3035 | Also disregard strings when preceded by an empty string of the other type. |
| 3036 | Returns (CONTENTS START END) for the found string, or nil if none found." |
| 3037 | (let (contents start end) |
| 3038 | (while (and (not contents) |
| 3039 | (re-search-forward "[#\"']" nil t)) |
| 3040 | (forward-char -1) |
| 3041 | (cond ((= (following-char) ?\#) |
| 3042 | ;; Disregard comments. |
| 3043 | (search-forward "\n")) |
| 3044 | ((looking-at "\"\"'") |
| 3045 | ;; Quintuple-quoted string |
| 3046 | (po-skip-over-python-string)) |
| 3047 | ((looking-at "''\"") |
| 3048 | ;; Quadruple-quoted string |
| 3049 | (po-skip-over-python-string)) |
| 3050 | (t |
| 3051 | ;; Simple-, double-, triple- or sextuple-quoted string. |
| 3052 | (if (memq (preceding-char) '(?r ?R)) |
| 3053 | (forward-char -1)) |
| 3054 | (setq start (point) |
| 3055 | contents (po-skip-over-python-string) |
| 3056 | end (point)) |
| 3057 | (goto-char start) |
| 3058 | (skip-chars-backward " \n\t") |
| 3059 | (cond ((= (preceding-char) ?\[) |
| 3060 | ;; Disregard a string used as a dictionary index. |
| 3061 | (setq contents nil)) |
| 3062 | ((= (preceding-char) ?\() |
| 3063 | ;; Isolate the keyword which precedes string. |
| 3064 | (backward-char 1) |
| 3065 | (skip-chars-backward " \n\t") |
| 3066 | (let ((end-keyword (point))) |
| 3067 | (skip-chars-backward "_A-Za-z0-9") |
| 3068 | (if (member (list (po-buffer-substring (point) |
| 3069 | end-keyword)) |
| 3070 | keywords) |
| 3071 | ;; Disregard already marked strings. |
| 3072 | (setq contents nil))))) |
| 3073 | (goto-char end)))) |
| 3074 | ;; Return the found string, if any. |
| 3075 | (and contents (list contents start end)))) |
| 3076 | |
| 3077 | (defun po-skip-over-python-string () |
| 3078 | "Skip over a Python string, possibly made up of many concatenated parts. |
| 3079 | Leave point after string. Return unquoted overall string contents." |
| 3080 | (let ((continue t) |
| 3081 | (contents "") |
| 3082 | raw start end resume) |
| 3083 | (while continue |
| 3084 | (skip-chars-forward " \t\n") ; whitespace |
| 3085 | (cond ((= (following-char) ?#) ; comment |
| 3086 | (setq start nil) |
| 3087 | (search-forward "\n")) |
| 3088 | ((looking-at "\\\n") ; escaped newline |
| 3089 | (setq start nil) |
| 3090 | (forward-char 2)) |
| 3091 | ((looking-at "[rR]?\"\"\"") ; sextuple-quoted string |
| 3092 | (setq raw (memq (following-char) '(?r ?R)) |
| 3093 | start (match-end 0)) |
| 3094 | (goto-char start) |
| 3095 | (search-forward "\"\"\"") |
| 3096 | (setq resume (point) |
| 3097 | end (- resume 3))) |
| 3098 | ((looking-at "[rr]?'''") ; triple-quoted string |
| 3099 | (setq raw (memq (following-char) '(?r ?R)) |
| 3100 | start (match-end 0)) |
| 3101 | (goto-char start) |
| 3102 | (search-forward "'''") |
| 3103 | (setq resume (point) |
| 3104 | end (- resume 3))) |
| 3105 | ((looking-at "[rR]?\"") ; double-quoted string |
| 3106 | (setq raw (memq (following-char) '(?r ?R)) |
| 3107 | start (match-end 0)) |
| 3108 | (goto-char start) |
| 3109 | (while (not (memq (following-char) '(0 ?\"))) |
| 3110 | (skip-chars-forward "^\"\\\\") |
| 3111 | (if (= (following-char) ?\\) (forward-char 2))) |
| 3112 | (if (eobp) |
| 3113 | (setq contents nil |
| 3114 | start nil) |
| 3115 | (setq end (point)) |
| 3116 | (forward-char 1)) |
| 3117 | (setq resume (point))) |
| 3118 | ((looking-at "[rR]?'") ; single-quoted string |
| 3119 | (setq raw (memq (following-char) '(?r ?R)) |
| 3120 | start (match-end 0)) |
| 3121 | (goto-char start) |
| 3122 | (while (not (memq (following-char) '(0 ?\'))) |
| 3123 | (skip-chars-forward "^'\\\\") |
| 3124 | (if (= (following-char) ?\\) (forward-char 2))) |
| 3125 | (if (eobp) |
| 3126 | (setq contents nil |
| 3127 | start nil) |
| 3128 | (setq end (point)) |
| 3129 | (forward-char 1)) |
| 3130 | (setq resume (point))) |
| 3131 | (t ; no string anymore |
| 3132 | (setq start nil |
| 3133 | continue nil))) |
| 3134 | (if start |
| 3135 | (setq contents (concat contents |
| 3136 | (if raw |
| 3137 | (buffer-substring start end) |
| 3138 | (po-extract-part-unquoted (current-buffer) |
| 3139 | start end)))))) |
| 3140 | (goto-char resume) |
| 3141 | contents)) |
| 3142 | |
| 3143 | (defun po-mark-python-string (start end keyword) |
| 3144 | "Mark the Python string, from START to END, with KEYWORD. |
| 3145 | If KEYWORD is '.', prefix the string with an empty string of the other type. |
| 3146 | Leave point after marked string." |
| 3147 | (cond ((string-equal keyword ".") |
| 3148 | (goto-char end) |
| 3149 | (save-excursion |
| 3150 | (goto-char start) |
| 3151 | (insert (cond ((= (following-char) ?\') "\"\"") |
| 3152 | ((= (following-char) ?\") "''") |
| 3153 | (t "??"))))) |
| 3154 | (t (goto-char end) |
| 3155 | (insert ")") |
| 3156 | (save-excursion |
| 3157 | (goto-char start) |
| 3158 | (insert keyword "("))))) |
| 3159 | \f |
| 3160 | ;;; Miscellaneous features. |
| 3161 | |
| 3162 | (defun po-help () |
| 3163 | "Provide an help window for PO mode." |
| 3164 | (interactive) |
| 3165 | (po-with-temp-buffer |
| 3166 | (insert po-help-display-string) |
| 3167 | (goto-char (point-min)) |
| 3168 | (save-window-excursion |
| 3169 | (switch-to-buffer (current-buffer)) |
| 3170 | (delete-other-windows) |
| 3171 | (message (_"Type any character to continue")) |
| 3172 | (po-read-event)))) |
| 3173 | |
| 3174 | (defun po-undo () |
| 3175 | "Undo the last change to the PO file." |
| 3176 | (interactive) |
| 3177 | (let ((buffer-read-only po-read-only)) |
| 3178 | (undo)) |
| 3179 | (po-compute-counters nil)) |
| 3180 | |
| 3181 | (defun po-statistics () |
| 3182 | "Say how many entries in each category, and the current position." |
| 3183 | (interactive) |
| 3184 | (po-compute-counters t)) |
| 3185 | |
| 3186 | (defun po-validate () |
| 3187 | "Use 'msgfmt' for validating the current PO file contents." |
| 3188 | (interactive) |
| 3189 | ;; The 'compile' subsystem is autoloaded through a call to (compile ...). |
| 3190 | ;; We need to initialize it outside of any binding. Without this statement, |
| 3191 | ;; all defcustoms and defvars of compile.el would be undone when the let* |
| 3192 | ;; terminates. |
| 3193 | (require 'compile) |
| 3194 | (let* ((dev-null |
| 3195 | (cond ((boundp 'null-device) null-device) ; since Emacs 20.3 |
| 3196 | ((memq system-type '(windows-nt windows-95)) "NUL") |
| 3197 | (t "/dev/null"))) |
| 3198 | (output |
| 3199 | (if po-keep-mo-file |
| 3200 | (concat (file-name-sans-extension buffer-file-name) ".mo") |
| 3201 | dev-null)) |
| 3202 | (compilation-buffer-name-function |
| 3203 | (function (lambda (mode-name) |
| 3204 | (concat "*" mode-name " validation*")))) |
| 3205 | (compile-command (concat po-msgfmt-program |
| 3206 | " --statistics -c -v -o " |
| 3207 | (shell-quote-argument output) " " |
| 3208 | (shell-quote-argument buffer-file-name)))) |
| 3209 | (po-msgfmt-version-check) |
| 3210 | (compile compile-command))) |
| 3211 | |
| 3212 | (defvar po-msgfmt-version-checked nil) |
| 3213 | (defun po-msgfmt-version-check () |
| 3214 | "'msgfmt' from GNU gettext 0.10.36 or greater is required." |
| 3215 | (po-with-temp-buffer |
| 3216 | (or |
| 3217 | ;; Don't bother checking again. |
| 3218 | po-msgfmt-version-checked |
| 3219 | |
| 3220 | (and |
| 3221 | ;; Make sure 'msgfmt' is available. |
| 3222 | (condition-case nil |
| 3223 | (call-process po-msgfmt-program |
| 3224 | nil t nil "--verbose" "--version") |
| 3225 | (file-error nil)) |
| 3226 | |
| 3227 | ;; Make sure there's a version number in the output: |
| 3228 | ;; 0.11 or 0.10.36 or 0.19.5.1 or 0.11-pre1 or 0.16.2-pre1 |
| 3229 | (progn (goto-char (point-min)) |
| 3230 | (or (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)$") |
| 3231 | (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$") |
| 3232 | (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$") |
| 3233 | (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)[-_A-Za-z0-9]+$") |
| 3234 | (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)[-_A-Za-z0-9]+$"))) |
| 3235 | |
| 3236 | ;; Make sure the version is recent enough. |
| 3237 | (>= (string-to-number |
| 3238 | (format "%d%03d%03d" |
| 3239 | (string-to-number (match-string 1)) |
| 3240 | (string-to-number (match-string 2)) |
| 3241 | (string-to-number (or (match-string 3) "0")))) |
| 3242 | 010036) |
| 3243 | |
| 3244 | ;; Remember the outcome. |
| 3245 | (setq po-msgfmt-version-checked t)) |
| 3246 | |
| 3247 | (error (_"'msgfmt' from GNU gettext 0.10.36 or greater is required"))))) |
| 3248 | |
| 3249 | (defun po-guess-archive-name () |
| 3250 | "Return the ideal file name for this PO file in the central archives." |
| 3251 | (let ((filename (file-name-nondirectory buffer-file-name)) |
| 3252 | start-of-header end-of-header package version team) |
| 3253 | (save-excursion |
| 3254 | ;; Find the PO file header entry. |
| 3255 | (goto-char (point-min)) |
| 3256 | (re-search-forward po-any-msgstr-block-regexp) |
| 3257 | (setq start-of-header (match-beginning 0) |
| 3258 | end-of-header (match-end 0)) |
| 3259 | ;; Get the package and version. |
| 3260 | (goto-char start-of-header) |
| 3261 | (if (re-search-forward "\n\ |
| 3262 | \"Project-Id-Version: \\(GNU \\|Free \\)?\\([^\n ]+\\) \\([^\n ]+\\)\\\\n\"$" |
| 3263 | end-of-header t) |
| 3264 | (setq package (po-match-string 2) |
| 3265 | version (po-match-string 3))) |
| 3266 | (if (or (not package) (string-equal package "PACKAGE") |
| 3267 | (not version) (string-equal version "VERSION")) |
| 3268 | (error (_"Project-Id-Version field does not have a proper value"))) |
| 3269 | ;; File name version and Project-Id-Version must match |
| 3270 | (cond (;; A `filename' w/o package and version info at all |
| 3271 | (string-match "^[^\\.]*\\.po\\'" filename)) |
| 3272 | (;; TP Robot compatible `filename': PACKAGE-VERSION.LL.po |
| 3273 | (string-match (concat (regexp-quote package) |
| 3274 | "-\\(.*\\)\\.[^\\.]*\\.po\\'") filename) |
| 3275 | (if (not (equal version (po-match-string 1 filename))) |
| 3276 | (error (_"\ |
| 3277 | Version mismatch: file name: %s; header: %s.\n\ |
| 3278 | Adjust Project-Id-Version field to match file name and try again") |
| 3279 | (po-match-string 1 filename) version)))) |
| 3280 | ;; Get the team. |
| 3281 | (if (stringp po-team-name-to-code) |
| 3282 | (setq team po-team-name-to-code) |
| 3283 | (goto-char start-of-header) |
| 3284 | (if (re-search-forward "\n\ |
| 3285 | \"Language-Team: \\([^ ].*[^ ]\\) <.+@.+>\\\\n\"$" |
| 3286 | end-of-header t) |
| 3287 | (let ((name (po-match-string 1))) |
| 3288 | (if name |
| 3289 | (let ((pair (assoc name po-team-name-to-code))) |
| 3290 | (if pair |
| 3291 | (setq team (cdr pair)) |
| 3292 | (setq team (read-string (format "\ |
| 3293 | Team name '%s' unknown. What is the team code? " |
| 3294 | name))))))))) |
| 3295 | (if (or (not team) (string-equal team "LL")) |
| 3296 | (error (_"Language-Team field does not have a proper value"))) |
| 3297 | ;; Compose the name. |
| 3298 | (concat package "-" version "." team ".po")))) |
| 3299 | |
| 3300 | (defun po-guess-team-address () |
| 3301 | "Return the team address related to this PO file." |
| 3302 | (let (team) |
| 3303 | (save-excursion |
| 3304 | (goto-char (point-min)) |
| 3305 | (re-search-forward po-any-msgstr-block-regexp) |
| 3306 | (goto-char (match-beginning 0)) |
| 3307 | (if (re-search-forward |
| 3308 | "\n\"Language-Team: +\\(.*<\\(.*\\)@.*>\\)\\\\n\"$" |
| 3309 | (match-end 0) t) |
| 3310 | (setq team (po-match-string 2))) |
| 3311 | (if (or (not team) (string-equal team "LL")) |
| 3312 | (error (_"Language-Team field does not have a proper value"))) |
| 3313 | (po-match-string 1)))) |
| 3314 | |
| 3315 | (defun po-send-mail () |
| 3316 | "Start composing a letter, possibly including the current PO file." |
| 3317 | (interactive) |
| 3318 | (let* ((team-flag (y-or-n-p |
| 3319 | (_"\ |
| 3320 | Write to your team? ('n' if writing to the Translation Project robot) "))) |
| 3321 | (address (if team-flag |
| 3322 | (po-guess-team-address) |
| 3323 | po-translation-project-address))) |
| 3324 | (if (not (y-or-n-p (_"Include current PO file in mail? "))) |
| 3325 | (apply po-compose-mail-function address |
| 3326 | (read-string (_"Subject? ")) nil) |
| 3327 | (if (buffer-modified-p) |
| 3328 | (error (_"The file is not even saved, you did not validate it."))) |
| 3329 | (if (and (y-or-n-p (_"You validated ('V') this file, didn't you? ")) |
| 3330 | (or (zerop po-untranslated-counter) |
| 3331 | (y-or-n-p |
| 3332 | (format (_"%d entries are untranslated, include anyway? ") |
| 3333 | po-untranslated-counter))) |
| 3334 | (or (zerop po-fuzzy-counter) |
| 3335 | (y-or-n-p |
| 3336 | (format (_"%d entries are still fuzzy, include anyway? ") |
| 3337 | po-fuzzy-counter))) |
| 3338 | (or (zerop po-obsolete-counter) |
| 3339 | (y-or-n-p |
| 3340 | (format (_"%d entries are obsolete, include anyway? ") |
| 3341 | po-obsolete-counter)))) |
| 3342 | (let ((buffer (current-buffer)) |
| 3343 | (name (po-guess-archive-name)) |
| 3344 | (transient-mark-mode nil) |
| 3345 | (coding-system-for-read buffer-file-coding-system) |
| 3346 | (coding-system-for-write buffer-file-coding-system)) |
| 3347 | (apply po-compose-mail-function address |
| 3348 | (if team-flag |
| 3349 | (read-string (_"Subject? ")) |
| 3350 | (format "%s %s" po-translation-project-mail-label name)) |
| 3351 | nil) |
| 3352 | (goto-char (point-min)) |
| 3353 | (re-search-forward |
| 3354 | (concat "^" (regexp-quote mail-header-separator) "\n")) |
| 3355 | (save-excursion |
| 3356 | (save-restriction |
| 3357 | (narrow-to-region (point) (point)) |
| 3358 | (insert-buffer-substring buffer) |
| 3359 | (shell-command-on-region |
| 3360 | (point-min) (point-max) |
| 3361 | (concat po-gzip-uuencode-command " " name ".gz") t t))))))) |
| 3362 | (message "")) |
| 3363 | |
| 3364 | (defun po-confirm-and-quit () |
| 3365 | "Confirm if quit should be attempted and then, do it. |
| 3366 | This is a failsafe. Confirmation is asked if only the real quit would not." |
| 3367 | (interactive) |
| 3368 | (if (po-check-all-pending-edits) |
| 3369 | (progn |
| 3370 | (if (or (buffer-modified-p) |
| 3371 | (> po-untranslated-counter 0) |
| 3372 | (> po-fuzzy-counter 0) |
| 3373 | (> po-obsolete-counter 0) |
| 3374 | (y-or-n-p (_"Really quit editing this PO file? "))) |
| 3375 | (po-quit)) |
| 3376 | (message "")))) |
| 3377 | |
| 3378 | (defun po-quit () |
| 3379 | "Save the PO file and kill buffer. |
| 3380 | However, offer validation if appropriate and ask confirmation if untranslated |
| 3381 | strings remain." |
| 3382 | (interactive) |
| 3383 | (if (po-check-all-pending-edits) |
| 3384 | (let ((quit t)) |
| 3385 | ;; Offer validation of newly modified entries. |
| 3386 | (if (and (buffer-modified-p) |
| 3387 | (not (y-or-n-p |
| 3388 | (_"File was modified; skip validation step? ")))) |
| 3389 | (progn |
| 3390 | (message "") |
| 3391 | (po-validate) |
| 3392 | ;; If we knew that the validation was all successful, we should |
| 3393 | ;; just quit. But since we do not know yet, as the validation |
| 3394 | ;; might be asynchronous with PO mode commands, the safest is to |
| 3395 | ;; stay within PO mode, even if this implies that another |
| 3396 | ;; 'po-quit' command will be later required to exit for true. |
| 3397 | (setq quit nil))) |
| 3398 | ;; Offer to work on untranslated entries. |
| 3399 | (if (and quit |
| 3400 | (or (> po-untranslated-counter 0) |
| 3401 | (> po-fuzzy-counter 0) |
| 3402 | (> po-obsolete-counter 0)) |
| 3403 | (not (y-or-n-p |
| 3404 | (_"Unprocessed entries remain; quit anyway? ")))) |
| 3405 | (progn |
| 3406 | (setq quit nil) |
| 3407 | (po-auto-select-entry))) |
| 3408 | ;; Clear message area. |
| 3409 | (message "") |
| 3410 | ;; Or else, kill buffers and quit for true. |
| 3411 | (if quit |
| 3412 | (progn |
| 3413 | (save-buffer) |
| 3414 | (kill-buffer (current-buffer))))))) |
| 3415 | |
| 3416 | ;;;###autoload (add-to-list 'auto-mode-alist '("\\.po[tx]?\\'\\|\\.po\\." . po-mode)) |
| 3417 | ;;;###autoload (modify-coding-system-alist 'file "\\.po[tx]?\\'\\|\\.po\\." 'po-find-file-coding-system) |
| 3418 | |
| 3419 | (provide 'po-mode) |
| 3420 | |
| 3421 | ;; Hey Emacs! |
| 3422 | ;; Local Variables: |
| 3423 | ;; indent-tabs-mode: nil |
| 3424 | ;; coding: utf-8 |
| 3425 | ;; End: |
| 3426 | |
| 3427 | ;;; po-mode.el ends here |