2694 lines
93 KiB
EmacsLisp
2694 lines
93 KiB
EmacsLisp
|
;;; po-mode.el -- for helping GNU gettext lovers to edit PO files.
|
|||
|
|
;;; Copyright (C) 1995-1998, 2000, 2001 Free Software Foundation, Inc.
|
|||
|
|
;;; Fran<61>ois Pinard <pinard@iro.umontreal.ca>, 1995.
|
|||
|
|
;;; Helped by Greg McGary <gkm@magilla.cichlid.com>.
|
|||
|
|
|
|||
|
|
;; 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.
|
|||
|
|
|
|||
|
|
;;; 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[tx]?\\'\\|\\.po\\." . po-mode)
|
|||
|
|
;;; auto-mode-alist))
|
|||
|
|
;;;
|
|||
|
|
;;; To automatically use the right coding system under Emacs 20, also add:
|
|||
|
|
;;;
|
|||
|
|
;;; (autoload 'po-find-file-coding-system "po-mode")
|
|||
|
|
;;; (modify-coding-system-alist 'file "\\.po[tx]?\\'\\|\\.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'.
|
|||
|
|
|
|||
|
|
;;; Emacs portability matters.
|
|||
|
|
|
|||
|
|
;;; Most portability matters are addressed in this page. All other cases
|
|||
|
|
;;; involve one of `eval-and-compile' or `fboundp', just search for these.
|
|||
|
|
|
|||
|
|
;; Identify which Emacs variety is being used.
|
|||
|
|
(eval-and-compile
|
|||
|
|
(cond ((string-match "Lucid\\|XEmacs" 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))))))
|
|||
|
|
|
|||
|
|
;; Protect string comparisons from text properties.
|
|||
|
|
(eval-and-compile
|
|||
|
|
(fset 'po-buffer-substring
|
|||
|
|
(symbol-function (if (fboundp 'buffer-substring-no-properties)
|
|||
|
|
'buffer-substring-no-properties
|
|||
|
|
'buffer-substring))))
|
|||
|
|
|
|||
|
|
;; Handle missing `with-temp-buffer' function.
|
|||
|
|
(eval-and-compile
|
|||
|
|
(if nil ; FIXME: just testing... (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."
|
|||
|
|
(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."
|
|||
|
|
(if buffer
|
|||
|
|
(save-excursion
|
|||
|
|
(set-buffer buffer)
|
|||
|
|
(isearch-highlight start end))
|
|||
|
|
(isearch-highlight start end))
|
|||
|
|
(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
|
|||
|
|
(name-buffer buffer)
|
|||
|
|
(po-highlight overlay start end buffer))))
|
|||
|
|
|
|||
|
|
(defun po-dehighlight (overlay)
|
|||
|
|
"Display normally the last string which OVERLAY highlighted."
|
|||
|
|
(isearch-dehighlight t)
|
|||
|
|
(setcar overlay (make-marker))
|
|||
|
|
(setcdr overlay (make-marker))))
|
|||
|
|
|
|||
|
|
(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
|
|||
|
|
(name-buffer 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))))
|
|||
|
|
|
|||
|
|
)))
|
|||
|
|
|
|||
|
|
;;; 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 'ask
|
|||
|
|
"*Automatically revise date in headers. Value is nil, t, or ask."
|
|||
|
|
:type '(choice (const nil)
|
|||
|
|
(const t)
|
|||
|
|
(const ask))
|
|||
|
|
:group 'po)
|
|||
|
|
|
|||
|
|
(defcustom po-default-file-header "\
|
|||
|
|
# SOME DESCRIPTIVE TITLE.
|
|||
|
|
# Copyright (C) YEAR Free Software Foundation, Inc.
|
|||
|
|
# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
|
|||
|
|
#
|
|||
|
|
#, fuzzy
|
|||
|
|
msgid \"\"
|
|||
|
|
msgstr \"\"
|
|||
|
|
\"Project-Id-Version: PACKAGE VERSION\\n\"
|
|||
|
|
\"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n\"
|
|||
|
|
\"Last-Translator: FULL NAME <EMAIL@ADDRESS>\\n\"
|
|||
|
|
\"Language-Team: LANGUAGE <LL@li.org>\\n\"
|
|||
|
|
\"MIME-Version: 1.0\\n\"
|
|||
|
|
\"Content-Type: text/plain; charset=CHARSET\\n\"
|
|||
|
|
\"Content-Transfer-Encoding: 8bit\\n\"
|
|||
|
|
"
|
|||
|
|
"*Default PO file header."
|
|||
|
|
:type 'string
|
|||
|
|
:group 'po)
|
|||
|
|
|
|||
|
|
(defcustom po-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-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)
|
|||
|
|
|
|||
|
|
;;; 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.
|
|||
|
|
;; NEXT-FILE-LIST is the list of source files to visit, gotten from the tags
|
|||
|
|
;; table. STRING-START is the position for the beginning of the last found
|
|||
|
|
;; string, or nil if the string is invalidated. STRING-END is the position
|
|||
|
|
;; for the end of the string and indicates where the search should be
|
|||
|
|
;; resumed, or nil for the beginning of the current file. 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-next-file-list)
|
|||
|
|
(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") (substring "$Revision: 1.1.1.1 $" 11 -2)))
|
|||
|
|
|
|||
|
|
(defconst po-help-display-string
|
|||
|
|
(_"\
|
|||
|
|
PO Mode Summary Next Previous Miscellaneous
|
|||
|
|
*: Later, /: Docum n p Any type . Redisplay
|
|||
|
|
/t /M-t Translated /v Version info
|
|||
|
|
Moving around f M-f Fuzzy ?, h This help
|
|||
|
|
< First if any o M-o Obsolete = Current index
|
|||
|
|
> Last if any u M-u Untranslated O Other window
|
|||
|
|
/SPC Auto select V Validate
|
|||
|
|
Msgstr Comments M Mail officially
|
|||
|
|
Modifying entries RET # Call editor U 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 M-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 t]
|
|||
|
|
"---"
|
|||
|
|
"Forward"
|
|||
|
|
["Any next" po-next-entry t]
|
|||
|
|
["Next translated" po-next-translated-entry t]
|
|||
|
|
["Next fuzzy" po-next-fuzzy-entry t]
|
|||
|
|
["Next obsolete" po-next-obsolete-entry t]
|
|||
|
|
["Next untranslated" po-next-untranslated-entry t]
|
|||
|
|
["Last file entry" po-last-entry t]
|
|||
|
|
"---"
|
|||
|
|
"Backward"
|
|||
|
|
["Any previous" po-previous-entry t]
|
|||
|
|
["Previous translated" po-previous-translated-entry t]
|
|||
|
|
["Previous fuzzy" po-previous-fuzzy-entry t]
|
|||
|
|
["Previous obsolete" po-previous-obsolete-entry t]
|
|||
|
|
["Previous untranslated" po-previous-untranslated-entry t]
|
|||
|
|
["First file entry" po-first-entry t]
|
|||
|
|
"---"
|
|||
|
|
"Position stack"
|
|||
|
|
["Mark and push current" po-push-location t]
|
|||
|
|
["Pop and return" po-pop-location t]
|
|||
|
|
["Exchange current/top" po-exchange-location t]
|
|||
|
|
"---"
|
|||
|
|
["Redisplay" po-current-entry t]
|
|||
|
|
["Current index" po-statistics t])
|
|||
|
|
("Modifying entries"
|
|||
|
|
["Undo" po-undo t]
|
|||
|
|
"---"
|
|||
|
|
"Msgstr"
|
|||
|
|
["Edit msgstr" po-edit-msgstr t]
|
|||
|
|
["Kill msgstr" po-kill-msgstr t]
|
|||
|
|
["Save msgstr" po-kill-ring-save-msgstr t]
|
|||
|
|
["Yank msgstr" po-yank-msgstr t]
|
|||
|
|
"---"
|
|||
|
|
"Comments"
|
|||
|
|
["Edit comment" po-edit-comment t]
|
|||
|
|
["Kill comment" po-kill-comment t]
|
|||
|
|
["Save comment" po-kill-ring-save-comment t]
|
|||
|
|
["Yank comment" po-yank-comment t]
|
|||
|
|
"---"
|
|||
|
|
["Remove fuzzy mark" po-unfuzzy t]
|
|||
|
|
["Fuzzy or fade out" po-fade-out-entry t]
|
|||
|
|
["Init with msgid" po-msgid-to-msgstr t])
|
|||
|
|
("Other files"
|
|||
|
|
["Other window" po-other-window t]
|
|||
|
|
"---"
|
|||
|
|
"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 t]
|
|||
|
|
["Help page" po-help t]
|
|||
|
|
["Validate" po-validate t]
|
|||
|
|
["Mail officially" po-send-mail t]
|
|||
|
|
["Edit out full" po-edit-out-full t]
|
|||
|
|
"---"
|
|||
|
|
["Forceful quit" po-quit t]
|
|||
|
|
["Soft quit" po-confirm-and-quit t])
|
|||
|
|
"Menu layout for PO mode.")
|
|||
|
|
|
|||
|
|
;; FIXME: subedit mode should also have its own layout.
|
|||
|
|
|
|||
|
|
(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.")
|
|||
|
|
|
|||
|
|
(defconst po-content-type-charset-alist
|
|||
|
|
'(; Note: Emacs 20 doesn't support all encodings, thus the missing entries.
|
|||
|
|
(ASCII . undecided)
|
|||
|
|
(ANSI_X3.4-1968 . undecided)
|
|||
|
|
(US-ASCII . undecided)
|
|||
|
|
(ISO-8859-1 . iso-8859-1)
|
|||
|
|
(ISO_8859-1 . iso-8859-1)
|
|||
|
|
(ISO-8859-2 . iso-8859-2)
|
|||
|
|
(ISO_8859-2 . iso-8859-2)
|
|||
|
|
(ISO-8859-3 . iso-8859-3)
|
|||
|
|
(ISO_8859-3 . iso-8859-3)
|
|||
|
|
(ISO-8859-4 . iso-8859-4)
|
|||
|
|
(ISO_8859-4 . iso-8859-4)
|
|||
|
|
(ISO-8859-5 . iso-8859-5)
|
|||
|
|
(ISO_8859-5 . iso-8859-5)
|
|||
|
|
;(ISO-8859-6 . ??)
|
|||
|
|
;(ISO_8859-6 . ??)
|
|||
|
|
(ISO-8859-7 . iso-8859-7)
|
|||
|
|
(ISO_8859-7 . iso-8859-7)
|
|||
|
|
(ISO-8859-8 . iso-8859-8)
|
|||
|
|
(ISO_8859-8 . iso-8859-8)
|
|||
|
|
(ISO-8859-9 . iso-8859-9)
|
|||
|
|
(ISO_8859-9 . iso-8859-9)
|
|||
|
|
;(ISO-8859-13 . ??)
|
|||
|
|
;(ISO_8859-13 . ??)
|
|||
|
|
(ISO-8859-15 . iso-8859-15) ; requires Emacs 21
|
|||
|
|
(ISO_8859-15 . iso-8859-15) ; requires Emacs 21
|
|||
|
|
(KOI8-R . koi8-r)
|
|||
|
|
;(KOI8-U . ??)
|
|||
|
|
;(CP850 . ??)
|
|||
|
|
;(CP866 . ??)
|
|||
|
|
;(CP874 . ??)
|
|||
|
|
;(CP932 . ??)
|
|||
|
|
;(CP949 . ??)
|
|||
|
|
;(CP950 . ??)
|
|||
|
|
;(CP1250 . ??)
|
|||
|
|
;(CP1251 . ??)
|
|||
|
|
;(CP1252 . ??)
|
|||
|
|
;(CP1253 . ??)
|
|||
|
|
;(CP1254 . ??)
|
|||
|
|
;(CP1255 . ??)
|
|||
|
|
;(CP1256 . ??)
|
|||
|
|
;(CP1257 . ??)
|
|||
|
|
(GB2312 . cn-gb-2312) ; also named 'gb2312' in XEmacs 21 or Emacs 21
|
|||
|
|
; also named 'euc-cn' in Emacs 20 or Emacs 21
|
|||
|
|
(EUC-JP . euc-jp)
|
|||
|
|
(EUC-KR . euc-kr)
|
|||
|
|
;(EUC-TW . ??)
|
|||
|
|
(BIG5 . big5)
|
|||
|
|
;(BIG5-HKSCS . ??)
|
|||
|
|
;(GBK . ??)
|
|||
|
|
;(GB18030 . ??)
|
|||
|
|
(SHIFT_JIS . shift_jis)
|
|||
|
|
;(JOHAB . ??)
|
|||
|
|
(TIS-620 . tis-620) ; requires Emacs 20 or Emacs 21
|
|||
|
|
(VISCII . viscii) ; requires Emacs 20 or Emacs 21
|
|||
|
|
(UTF-8 . utf-8) ; requires Mule-UCS in Emacs 20, or Emacs 21
|
|||
|
|
)
|
|||
|
|
"How to convert a GNU libc/libiconv canonical charset name as seen in
|
|||
|
|
Content-Type into a Mule coding system.")
|
|||
|
|
|
|||
|
|
(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-translation-project-address
|
|||
|
|
"translation@iro.umontreal.ca"
|
|||
|
|
"Electronic mail address of the Translation Project.")
|
|||
|
|
|
|||
|
|
(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.
|
|||
|
|
|
|||
|
|
(eval-and-compile
|
|||
|
|
(if (or po-EMACS20 po-XEMACS)
|
|||
|
|
(defun po-find-file-coding-system-guts (operation filename)
|
|||
|
|
"Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
|
|||
|
|
Called through file-coding-system-alist, before the file is visited for real."
|
|||
|
|
(and (eq operation 'insert-file-contents)
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(let ((coding-system-for-read 'no-conversion))
|
|||
|
|
;; Is 4096 enough? FIXME: Retry as needed!
|
|||
|
|
(insert-file-contents filename nil 0 4096)
|
|||
|
|
(if (re-search-forward
|
|||
|
|
"^\"Content-Type: text/plain;[ \t]*charset=\\([^\\]+\\)"
|
|||
|
|
nil t)
|
|||
|
|
(let* ((charset (buffer-substring
|
|||
|
|
(match-beginning 1) (match-end 1)))
|
|||
|
|
(charset-upper (intern (upcase charset)))
|
|||
|
|
(charset-lower (intern (downcase charset))))
|
|||
|
|
(list (or (cdr (assq charset-upper
|
|||
|
|
po-content-type-charset-alist))
|
|||
|
|
(if (memq charset-lower (coding-system-list))
|
|||
|
|
charset-lower
|
|||
|
|
'no-conversion))))
|
|||
|
|
'(no-conversion)))))))
|
|||
|
|
|
|||
|
|
(if po-EMACS20
|
|||
|
|
(defun po-find-file-coding-system (arg-list)
|
|||
|
|
"Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
|
|||
|
|
Called through file-coding-system-alist, before the file is visited for real."
|
|||
|
|
(po-find-file-coding-system-guts (car arg-list) (car (cdr arg-list)))))
|
|||
|
|
|
|||
|
|
(if po-XEMACS
|
|||
|
|
(defun po-find-file-coding-system (operation filename)
|
|||
|
|
"Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
|
|||
|
|
Called through file-coding-system-alist, before the file is visited for real."
|
|||
|
|
(po-find-file-coding-system-guts operation filename)))
|
|||
|
|
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
(defvar po-mode-map nil
|
|||
|
|
"Keymap for PO mode.")
|
|||
|
|
(if po-mode-map
|
|||
|
|
()
|
|||
|
|
;; The following line because (make-sparse-keymap) does not work on Demacs.
|
|||
|
|
(setq 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 "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-other-window)
|
|||
|
|
(define-key po-mode-map "Q" 'po-quit)
|
|||
|
|
(define-key po-mode-map "S" 'po-consider-source-path)
|
|||
|
|
(define-key po-mode-map "U" 'po-undo)
|
|||
|
|
(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 "\177" 'po-fade-out-entry)
|
|||
|
|
(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-a" 'po-select-auxiliary)
|
|||
|
|
;;;; (define-key po-mode-map "\M-c" 'po-select-and-save-entry)
|
|||
|
|
(define-key po-mode-map "\M-f" 'po-previous-fuzzy-entry)
|
|||
|
|
;;;; (define-key po-mode-map "\M-l" 'po-edit-lexicon-entry)
|
|||
|
|
(define-key po-mode-map "\M-o" 'po-previous-obsolete-entry)
|
|||
|
|
(define-key po-mode-map "\M-t" 'po-previous-translated-entry)
|
|||
|
|
(define-key po-mode-map "\M-u" 'po-previous-untranslated-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)
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
(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))))
|
|||
|
|
(make-local-variable 'font-lock-defaults)
|
|||
|
|
(setq font-lock-defaults '(po-font-lock-keywords t))
|
|||
|
|
|
|||
|
|
(make-local-variable 'po-read-only)
|
|||
|
|
(setq po-read-only buffer-read-only
|
|||
|
|
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)
|
|||
|
|
|
|||
|
|
(make-local-variable 'po-edited-fields)
|
|||
|
|
(setq po-edited-fields nil)
|
|||
|
|
|
|||
|
|
(make-local-variable 'po-marker-stack)
|
|||
|
|
(setq po-marker-stack nil)
|
|||
|
|
|
|||
|
|
(make-local-variable 'po-search-path)
|
|||
|
|
(setq po-search-path '(("./") ("../")))
|
|||
|
|
|
|||
|
|
(make-local-variable 'po-reference-alist)
|
|||
|
|
(make-local-variable 'po-reference-cursor)
|
|||
|
|
(make-local-variable 'po-reference-check)
|
|||
|
|
(setq po-reference-alist nil
|
|||
|
|
po-reference-cursor nil
|
|||
|
|
po-reference-check 0)
|
|||
|
|
|
|||
|
|
(make-local-variable 'po-keywords)
|
|||
|
|
(make-local-variable 'po-next-file-list)
|
|||
|
|
(make-local-variable 'po-string-start)
|
|||
|
|
(make-local-variable 'po-string-end)
|
|||
|
|
(make-local-variable 'po-marking-overlay)
|
|||
|
|
(setq po-keywords '(("gettext") ("gettext_noop") ("_") ("N_"))
|
|||
|
|
po-next-file-list nil
|
|||
|
|
po-string-start nil
|
|||
|
|
po-string-end nil
|
|||
|
|
po-marking-overlay (po-create-overlay))
|
|||
|
|
|
|||
|
|
(message (_"You may type `h' or `?' for a short PO mode reminder."))
|
|||
|
|
(run-hooks 'po-mode-hook))
|
|||
|
|
|
|||
|
|
;;; 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)
|
|||
|
|
(let ((entry (member 'global-mode-string mode-line-format)))
|
|||
|
|
(setcdr entry (cons po-mode-line-entry (cdr 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) here)
|
|||
|
|
(save-excursion
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(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) po-start-of-msgstr) (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))
|
|||
|
|
(and insert-flag (insert po-default-file-header "\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 untranslated entry, wrapping around if necessary."
|
|||
|
|
(interactive)
|
|||
|
|
(if (= po-translated-counter 0)
|
|||
|
|
(error (_"There is no such entry"))
|
|||
|
|
(po-next-entry-with-regexp po-untranslated-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 untranslated 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."
|
|||
|
|
(po-with-temp-buffer
|
|||
|
|
(insert-buffer-substring buffer start end)
|
|||
|
|
;; Remove preceding crumb.
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(search-forward "\"")
|
|||
|
|
(delete-region (point-min) (point))
|
|||
|
|
;; Remove following crumb.
|
|||
|
|
(goto-char (point-max))
|
|||
|
|
(search-backward "\"")
|
|||
|
|
(delete-region (point) (point-max))
|
|||
|
|
;; 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\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) ?\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-buffer-substring (match-beginning 0)
|
|||
|
|
(match-end 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
|
|||
|
|
(when (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-buffer-substring (match-beginning 0)
|
|||
|
|
(match-end 0))
|
|||
|
|
string))
|
|||
|
|
(let ((buffer-read-only po-read-only))
|
|||
|
|
(po-decrease-type-counter)
|
|||
|
|
(replace-match string t t)
|
|||
|
|
(goto-char (match-beginning 0))
|
|||
|
|
(unless (eq msgstr-idx nil) ; hack: replace msgstr with msgstr[d]
|
|||
|
|
(progn
|
|||
|
|
(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 (yes-or-no-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-buffer-substring (match-beginning 0)
|
|||
|
|
(match-end 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")))))
|
|||
|
|
|
|||
|
|
(defvar po-subedit-mode-map nil
|
|||
|
|
"Keymap while editing a PO mode entry (or the full PO file).")
|
|||
|
|
(if po-subedit-mode-map
|
|||
|
|
()
|
|||
|
|
(setq po-subedit-mode-map (make-sparse-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-k" 'po-subedit-abort))
|
|||
|
|
|
|||
|
|
(defun po-subedit-abort ()
|
|||
|
|
"Exit the subedit buffer, merely discarding its contents."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((edit-buffer (current-buffer))
|
|||
|
|
(back-pointer po-subedit-back-pointer)
|
|||
|
|
(marker (nth 0 back-pointer))
|
|||
|
|
(overlay (nth 2 back-pointer))
|
|||
|
|
(buffer (marker-buffer marker)))
|
|||
|
|
(if (null buffer)
|
|||
|
|
(error (_"Corresponding PO buffer does not exist anymore"))
|
|||
|
|
(or (one-window-p) (delete-window))
|
|||
|
|
(switch-to-buffer buffer)
|
|||
|
|
(goto-char marker)
|
|||
|
|
(and overlay (po-dehighlight overlay))
|
|||
|
|
(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) "*")))
|
|||
|
|
(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)
|
|||
|
|
(make-local-variable 'po-subedit-back-pointer)
|
|||
|
|
(setq po-subedit-back-pointer slot)
|
|||
|
|
(erase-buffer)
|
|||
|
|
(insert string "<")
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(and expand-tabs (setq indent-tabs-mode nil))
|
|||
|
|
(use-local-map po-subedit-mode-map)
|
|||
|
|
(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-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))
|
|||
|
|
|
|||
|
|
;;; 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)
|
|||
|
|
;; FIXME:
|
|||
|
|
(po-highlight (po-create-overlay) (point) end))))
|
|||
|
|
(goto-char po-start-of-msgid))
|
|||
|
|
(goto-char start)
|
|||
|
|
(po-find-span-of-entry)
|
|||
|
|
(select-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)
|
|||
|
|
(if po-buffer-of-edited-entry
|
|||
|
|
(let ((buffer (current-buffer)))
|
|||
|
|
(pop-to-buffer po-buffer-of-edited-entry)
|
|||
|
|
(po-cycle-auxiliary)
|
|||
|
|
(pop-to-buffer buffer))
|
|||
|
|
(error (_"Not editing a PO file entry"))))
|
|||
|
|
|
|||
|
|
(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)
|
|||
|
|
()
|
|||
|
|
(setq po-reference-alist nil)
|
|||
|
|
(save-excursion
|
|||
|
|
(goto-char po-start-of-entry)
|
|||
|
|
(if (re-search-forward "^#:" po-start-of-msgid t)
|
|||
|
|
(while (looking-at "\\(\n#:\\)? *\\([^: ]+\\):\\([0-9]+\\)")
|
|||
|
|
(goto-char (match-end 0))
|
|||
|
|
(let* ((name (po-buffer-substring (match-beginning 2)
|
|||
|
|
(match-end 2)))
|
|||
|
|
(line (po-buffer-substring (match-beginning 3)
|
|||
|
|
(match-end 3)))
|
|||
|
|
(path po-search-path)
|
|||
|
|
file)
|
|||
|
|
(while (and (progn (setq file (concat (car (car path)) name))
|
|||
|
|
(not (file-exists-p file)))
|
|||
|
|
path)
|
|||
|
|
(setq path (cdr path)))
|
|||
|
|
(if path
|
|||
|
|
(setq po-reference-alist
|
|||
|
|
(cons (list (concat file ":" line)
|
|||
|
|
file
|
|||
|
|
(string-to-int 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"))))
|
|||
|
|
|
|||
|
|
;;; Program sources strings though tags table.
|
|||
|
|
|
|||
|
|
;;; C mode.
|
|||
|
|
|
|||
|
|
;;; 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 (START . END) for the found string, or (nil . 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)))))))))
|
|||
|
|
|
|||
|
|
;; Return the found string, if any.
|
|||
|
|
(cons start end)))
|
|||
|
|
|
|||
|
|
(defun po-mark-c-string (start end keyword)
|
|||
|
|
"Mark the C string, from START to END, with KEYWORD.
|
|||
|
|
Return the adjusted value for END."
|
|||
|
|
(goto-char end)
|
|||
|
|
(insert ")")
|
|||
|
|
(goto-char start)
|
|||
|
|
(insert keyword)
|
|||
|
|
(if (not (string-equal keyword "_"))
|
|||
|
|
(progn (insert " ") (setq end (1+ end))))
|
|||
|
|
(insert "(")
|
|||
|
|
(+ end 2 (length keyword)))
|
|||
|
|
|
|||
|
|
;;; Emacs LISP mode.
|
|||
|
|
|
|||
|
|
(defun po-find-emacs-lisp-string (keywords)
|
|||
|
|
"Find the next Emacs LISP string, excluding those marked by any of KEYWORDS.
|
|||
|
|
Returns (START . END) for the found string, or (nil . 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.
|
|||
|
|
(cons start end)))
|
|||
|
|
|
|||
|
|
(defun po-mark-emacs-lisp-string (start end keyword)
|
|||
|
|
"Mark the Emacs LISP string, from START to END, with KEYWORD.
|
|||
|
|
Return the adjusted value for END."
|
|||
|
|
(goto-char end)
|
|||
|
|
(insert ")")
|
|||
|
|
(goto-char start)
|
|||
|
|
(insert "(" keyword)
|
|||
|
|
(if (not (string-equal keyword "_"))
|
|||
|
|
(progn (insert " ") (setq end (1+ end))))
|
|||
|
|
(+ end 2 (length keyword)))
|
|||
|
|
|
|||
|
|
;;; Processing generic to all programming modes.
|
|||
|
|
|
|||
|
|
(eval-and-compile
|
|||
|
|
(autoload 'visit-tags-table-buffer "etags"))
|
|||
|
|
|
|||
|
|
(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")
|
|||
|
|
|
|||
|
|
;; Take care of restarting the search if necessary.
|
|||
|
|
(if restart (setq po-next-file-list nil))
|
|||
|
|
|
|||
|
|
;; Loop doing things until an interesting string is found.
|
|||
|
|
(let ((keywords po-keywords)
|
|||
|
|
found buffer start
|
|||
|
|
(end po-string-end))
|
|||
|
|
(while (not found)
|
|||
|
|
|
|||
|
|
;; Reinitialize the source file list if necessary.
|
|||
|
|
(if (not po-next-file-list)
|
|||
|
|
(progn
|
|||
|
|
(setq po-next-file-list
|
|||
|
|
(save-excursion
|
|||
|
|
(visit-tags-table-buffer)
|
|||
|
|
(copy-sequence (tags-table-files))))
|
|||
|
|
(or po-next-file-list (error (_"No files to process")))
|
|||
|
|
(setq end nil)))
|
|||
|
|
|
|||
|
|
;; Try finding a string after resuming the search position.
|
|||
|
|
(message (_"Scanning %s...") (car po-next-file-list))
|
|||
|
|
(save-excursion
|
|||
|
|
(setq buffer (find-file-noselect (car po-next-file-list)))
|
|||
|
|
(set-buffer buffer)
|
|||
|
|
(goto-char (or end (point-min)))
|
|||
|
|
|
|||
|
|
(cond ((member mode-name '("C" "C++"))
|
|||
|
|
(let ((pair (po-find-c-string keywords)))
|
|||
|
|
(setq start (car pair)
|
|||
|
|
end (cdr pair))))
|
|||
|
|
((string-equal mode-name "Emacs-Lisp")
|
|||
|
|
(let ((pair (po-find-emacs-lisp-string keywords)))
|
|||
|
|
(setq start (car pair)
|
|||
|
|
end (cdr pair))))
|
|||
|
|
(t (message (_"Unknown source mode for PO mode, skipping..."))
|
|||
|
|
(setq start nil
|
|||
|
|
end nil))))
|
|||
|
|
|
|||
|
|
;; Advance to next file if no string was found.
|
|||
|
|
(if (not start)
|
|||
|
|
(progn
|
|||
|
|
(setq po-next-file-list (cdr po-next-file-list))
|
|||
|
|
(if po-next-file-list
|
|||
|
|
(setq end nil)
|
|||
|
|
(setq po-string-end nil)
|
|||
|
|
(and po-highlighting (po-dehighlight po-marking-overlay))
|
|||
|
|
(error (_"All files processed"))))
|
|||
|
|
|
|||
|
|
;; Push the string just found string into a work buffer for study.
|
|||
|
|
(po-with-temp-buffer
|
|||
|
|
(insert (po-extract-unquoted buffer start end))
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
|
|||
|
|
;; Do not disregard if at least three letters in a row.
|
|||
|
|
(if (re-search-forward "[A-Za-z][A-Za-z][A-Za-z]" nil t)
|
|||
|
|
(setq found t)
|
|||
|
|
|
|||
|
|
;; Disregard if two letters, and more punctuations than letters.
|
|||
|
|
(if (re-search-forward "[A-Za-z][A-Za-z]" nil t)
|
|||
|
|
(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 found t))))
|
|||
|
|
|
|||
|
|
;; Disregard if single letters or no letters at all.
|
|||
|
|
))))
|
|||
|
|
|
|||
|
|
;; Ensure the string is being displayed.
|
|||
|
|
|
|||
|
|
(if (one-window-p t) (split-window) (other-window 1))
|
|||
|
|
(switch-to-buffer 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))
|
|||
|
|
(other-window 1)
|
|||
|
|
(and po-highlighting (po-highlight po-marking-overlay start end buffer))
|
|||
|
|
|
|||
|
|
;; Save the string for later commands.
|
|||
|
|
(message (_"Scanning %s...done") (car po-next-file-list))
|
|||
|
|
(setq po-string-start start
|
|||
|
|
po-string-end end)))
|
|||
|
|
|
|||
|
|
(defun po-mark-found-string (keyword)
|
|||
|
|
"Mark last found string in program sources as translatable, using KEYWORD."
|
|||
|
|
(and po-highlighting (po-dehighlight po-marking-overlay))
|
|||
|
|
(let ((buffer (find-file-noselect (car po-next-file-list)))
|
|||
|
|
(start po-string-start)
|
|||
|
|
(end po-string-end)
|
|||
|
|
line string)
|
|||
|
|
|
|||
|
|
;; Mark string in program sources.
|
|||
|
|
(setq string (po-extract-unquoted buffer start end))
|
|||
|
|
(save-excursion
|
|||
|
|
(set-buffer buffer)
|
|||
|
|
(setq line (count-lines (point-min) start)
|
|||
|
|
end (cond ((member mode-name '("C" "C++"))
|
|||
|
|
(po-mark-c-string start end keyword))
|
|||
|
|
((string-equal mode-name "Emacs-Lisp")
|
|||
|
|
(po-mark-emacs-lisp-string start end keyword))
|
|||
|
|
(t (error (_"Cannot mark in unknown source mode"))))))
|
|||
|
|
(setq po-string-end end)
|
|||
|
|
|
|||
|
|
;; Add PO file entry.
|
|||
|
|
(let ((buffer-read-only po-read-only))
|
|||
|
|
(goto-char (point-max))
|
|||
|
|
(insert "\n" (format "#: %s:%d\n" (car po-next-file-list) line))
|
|||
|
|
(save-excursion
|
|||
|
|
(insert (po-eval-requoted string "msgid" nil) "msgstr \"\"\n"))
|
|||
|
|
(setq po-untranslated-counter (1+ po-untranslated-counter))
|
|||
|
|
(po-update-mode-line-string))))
|
|||
|
|
|
|||
|
|
(defun po-mark-translatable ()
|
|||
|
|
"Mark last found string in program sources as translatable, using `_'."
|
|||
|
|
(interactive)
|
|||
|
|
(if (and po-string-start po-string-end)
|
|||
|
|
(progn
|
|||
|
|
(po-mark-found-string "_")
|
|||
|
|
(setq po-string-start nil))
|
|||
|
|
(error (_"No such 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))))
|
|||
|
|
(if (and po-string-start po-string-end)
|
|||
|
|
(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)
|
|||
|
|
(setq po-string-start nil))
|
|||
|
|
(error (_"No such string")))))
|
|||
|
|
|
|||
|
|
;;; 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)
|
|||
|
|
|
|||
|
|
;; If modifications were done already, change the last revision date.
|
|||
|
|
(if (buffer-modified-p)
|
|||
|
|
(po-replace-revision-date))
|
|||
|
|
|
|||
|
|
;; This `let' is for protecting the previous value of compile-command.
|
|||
|
|
(let ((compile-command (concat po-msgfmt-program
|
|||
|
|
" --statistics -c -v -o /dev/null "
|
|||
|
|
buffer-file-name)))
|
|||
|
|
(compile compile-command)))
|
|||
|
|
|
|||
|
|
(defun po-guess-archive-name ()
|
|||
|
|
"Return the ideal file name for this PO file in the central archives."
|
|||
|
|
(let (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\\)? \\([^\n ]+\\) \\([^\n ]+\\)\\\\n\"$"
|
|||
|
|
end-of-header t)
|
|||
|
|
(setq package (buffer-substring (match-beginning 2) (match-end 2))
|
|||
|
|
version (buffer-substring (match-beginning 3) (match-end 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")))
|
|||
|
|
;; Get the team.
|
|||
|
|
(goto-char start-of-header)
|
|||
|
|
(if (re-search-forward "\n\"Language-Team:.*<\\(.*\\)@li.org>\\\\n\"$"
|
|||
|
|
end-of-header t)
|
|||
|
|
(setq team (buffer-substring (match-beginning 1) (match-end 1))))
|
|||
|
|
(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: +\\(.*<\\(.*\\)@li.org>\\)\\\\n\"$"
|
|||
|
|
(match-end 0) t)
|
|||
|
|
(setq team (buffer-substring (match-beginning 2) (match-end 2))))
|
|||
|
|
(if (or (not team) (string-equal team "LL"))
|
|||
|
|
(error (_"Language-Team field does not have a proper value")))
|
|||
|
|
(buffer-substring (match-beginning 1) (match-end 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' means writing to translation project) ")))
|
|||
|
|
(address (if team-flag
|
|||
|
|
(po-guess-team-address)
|
|||
|
|
po-translation-project-address)))
|
|||
|
|
(if (not (y-or-n-p (_"Include current PO file? ")))
|
|||
|
|
(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))
|
|||
|
|
(apply po-compose-mail-function address
|
|||
|
|
(if team-flag
|
|||
|
|
(read-string (_"Subject? "))
|
|||
|
|
(format "TP-Robot %s" 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
|
|||
|
|
(and (buffer-modified-p) (po-replace-revision-date))
|
|||
|
|
(save-buffer)
|
|||
|
|
(kill-buffer (current-buffer)))))))
|
|||
|
|
|
|||
|
|
;;; po-mode.el ends here
|