projects / ~bandali / configs / blame
| Commit | Line | Data |
|---|---|---|
| 48edf7d2 AB |
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 |