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