;;; po-mode.el -- for helping GNU gettext lovers to edit PO files. ;;; Copyright (C) 1995 Free Software Foundation, Inc. ;;; François Pinard , 1995. ;;; Helped by Greg McGary . ;; 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: ;;; ;;; (setq auto-mode-alist ;;; (cons (cons "\\.pox?\\'" 'po-mode) auto-mode-alist)) ;;; (autoload 'po-mode "po-mode") (defun po-mode-version () "Show Emacs PO mode version." (interactive) (message "Emacs PO mode, version %s" (substring "$Revision: 1.18 $" 11 -2))) (defvar po-help-display-string " Summary of PO mode Commands (* means yet to come) Any Type of Entry Obsolete Entries Untranslated Entries n, SPC Find next M-n, M-SPC Find next e Find next p, DEL Find previous M-p, M-DEL Find previous M-e Find previous . Redisplay TAB Init from msgid < First q quit u undo > Last o other window = position *s To compendium z Fade out h, ? help v validate *M-s Select, save V version info Inexact entries I Find next Translations Translator Comments M-I Find previous RET Call editor M-RET, # Call editor ??? Remove warning k Kill to ring M-k Kill to ring w Copy to ring M-w Copy to ring Position Stack y Yank from ring M-y Yank from ring m Push current l Pop and return Program Sources Auxiliary Files x Exchange top c Cycle reference *a Cycle file M-c Select reference *M-a Select file gettext Keyword Marking d Add to path *f Add file , Find next string M-d Delete from path *M-f Delete file M-, Mark translatable M-. Change mark, mark ") (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\\)*" "Regexp matching a whole msgstr field, whether obsolete or not.") (defvar po-msgfmt-program "msgfmt" "Path to msgfmt program from GNU gettext package.") ;; Highlight PO files if hilit19.elc has been loaded first. (if (fboundp 'hilit-set-mode-patterns) (hilit-set-mode-patterns 'po-mode '(("^#.*$" nil comment) ;; Hilighting strings is overkill, don't do it. ;; (hilit-string-find ?\\ string) ("^\\(msgid\\|msgstr\\)\\>" nil keyword)))) ;; Highlight PO files if font-lock.elc has been loaded first. (defconst po-font-lock-keywords (purecopy (list '("^#.*$" . font-lock-comment-face) '("^#:\\(.*\\)\\>" 1 font-lock-function-name-face t) '("^\\(msgid\\|msgstr\\)\\>" . font-lock-keyword-face) )) "Additional expressions to highlight in po-mode.") (if (boundp 'font-lock-keywords) (put 'po-mode 'font-lock-keywords 'po-font-lock-keywords)) ;;; Mode activation. (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-msgid-to-msgstr) (define-key po-mode-map "\C-m" 'po-edit-msgstr) (define-key po-mode-map " " 'po-next-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-cycle-reference) (define-key po-mode-map "d" 'po-add-path) (define-key po-mode-map "e" 'po-next-untranslated-entry) ;;;; (define-key po-mode-map "f" 'po-add-auxiliary) (define-key po-mode-map "h" 'po-help) (define-key po-mode-map "i" 'po-next-inexact) (define-key po-mode-map "k" 'po-kill-msgstr) (define-key po-mode-map "l" 'po-pop-location) (define-key po-mode-map "m" 'po-push-location) (define-key po-mode-map "n" 'po-next-entry) (define-key po-mode-map "p" 'po-previous-entry) (define-key po-mode-map "o" 'po-other-window) (define-key po-mode-map "q" 'po-quit) ;;;; (define-key po-mode-map "s" 'po-save-entry) (define-key po-mode-map "u" 'po-undo) (define-key po-mode-map "v" 'po-validate) (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 "y" 'po-yank-msgstr) (define-key po-mode-map "x" 'po-exchange-location) (define-key po-mode-map "z" 'po-fade-out-entry) (define-key po-mode-map "\177" 'po-previous-entry) (define-key po-mode-map "\M-\C-m" 'po-edit-comment) (define-key po-mode-map "\M- " 'po-next-obsolete-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-reference) (define-key po-mode-map "\M-d" 'po-delete-path) (define-key po-mode-map "\M-e" 'po-previous-untranslated-entry) ;;;; (define-key po-mode-map "\M-f" 'po-delete-auxiliary) (define-key po-mode-map "\M-i" 'po-previous-inexact) (define-key po-mode-map "\M-k" 'po-kill-comment) (define-key po-mode-map "\M-n" 'po-next-obsolete-entry) (define-key po-mode-map "\M-p" 'po-previous-obsolete-entry) ;;;; (define-key po-mode-map "\M-s" 'po-select-and-save-entry) (define-key po-mode-map "\M-w" 'po-kill-ring-save-comment) (define-key po-mode-map "\M-y" 'po-yank-comment) (define-key po-mode-map "\M-\177" 'po-previous-obsolete-entry)) (defvar po-edit-mode-map nil "Keymap while editing a PO mode entry.") (if po-edit-mode-map () (setq po-edit-mode-map (make-sparse-keymap)) (define-key po-edit-mode-map "\C-c\C-c" 'exit-recursive-edit)) (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-hooks', if that value is non-nil." (interactive) (kill-all-local-variables) (setq major-mode 'po-mode) (setq mode-name "PO") (use-local-map po-mode-map) (setq buffer-read-only t) ;; The current entry extends from START-OF-ENTRY to END-OF-ENTRY, ;; and the line containing the msgstr keyword line starts at ;; MIDDLE-OF-ENTRY. OBSOLETE-FLAG is t for all commented entries. (make-local-variable 'po-start-of-entry) (make-local-variable 'po-middle-of-entry) (make-local-variable 'po-end-of-entry) (make-local-variable 'po-obsolete-flag) ;; A WORK-BUFFER is associated with this PO file, for edition ;; and other various tasks. WORK-BUFFER-LOCK indicates that ;; the work buffer is already in use, most probably editing some ;; string through Emacs recursive edit. In this case, one cannot ;; modify the buffer. (make-local-variable 'po-work-buffer) (make-local-variable 'po-work-buffer-lock) (setq po-work-buffer (generate-new-buffer (concat "*Edit " (buffer-name nil) "*"))) (setq po-work-buffer-lock nil) ;; We maintain a set of movable pointers for returning to entries. (make-local-variable 'po-marker-stack) (setq po-marker-stack nil) ;; 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 "../". (make-local-variable 'po-search-path) (setq 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. (make-local-variable 'po-reference-alist) (make-local-variable 'po-reference-cursor) (make-local-variable 'po-reference-check) (setq po-reference-alist nil) (setq po-reference-cursor nil) (setq po-reference-check 0) ;; The following variables are for marking translatable strings in ;; program sources. 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. ;; KEYWORDS is the list of keywords for marking translatable ;; strings, kept in a format suitable for reading with completion. (make-local-variable 'po-next-file-list) (make-local-variable 'po-string-start) (make-local-variable 'po-string-end) (make-local-variable 'po-keywords) (setq po-next-file-list nil) (setq po-string-start nil) (setq po-string-end nil) (setq po-keywords '(("gettext") ("_"))) ;; OFFER-VALIDATION is set to t when buffer is modified, and reset ;; to nil by validation. At quit time, validation may be offered. (make-local-variable 'po-offer-validation) (setq po-offer-validation nil) ;; When this file was generated using msgmerge it might contain ;; translations which did not match exactly. This should be known ;; to the user. (if (re-search-forward "^#! INEXACT" nil t) (error "The file contains INEXACT warnings!")) (run-hooks 'po-mode-hooks)) ;;; Window management. (defun po-redisplay () "Redisplay the current entry." (goto-char po-middle-of-entry)) (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))) (defun po-check-lock () "Ensure that GNU Emacs is not currently in recursive edit for PO mode." (if po-work-buffer-lock (progn (pop-to-buffer po-work-buffer) (if (y-or-n-p "Here is your current edit. Do you wish to abort it? ") (abort-recursive-edit) (error "Type `C-c C-c' once done"))))) ;;; Identifying the span of an entry. (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-MIDDLE-OF-ENTRY, PO-END-OF-ENTRY and PO-OBSOLETE-FLAG to meaningful values." (let ((here (point))) (if (re-search-backward po-any-msgstr-regexp nil t) (progn ;; After a backward match, under Emacs 19.22 at least, ;; (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 and use (point) instead. (re-search-forward po-any-msgstr-regexp) (if (<= (point) here) ;; The cursor was before msgstr of its own entry, ;; so we just found the msgstr of the previous entry. (progn (setq po-start-of-entry (point)) (if (re-search-forward po-any-msgstr-regexp nil t) (progn (setq po-middle-of-entry (match-beginning 0)) (setq po-end-of-entry (match-end 0))) ;; There is no msgstr to this entry, so we ought to ;; be in the crumb after the last entry in the file. (error "After last entry"))) ;; The cursor was inside msgstr of the current entry. (setq po-middle-of-entry (match-beginning 0)) (setq po-end-of-entry (match-end 0)) (goto-char (match-beginning 0)) (if (re-search-backward po-any-msgstr-regexp nil t) ;; This is not the first entry in the file. (progn (goto-char (match-end 0)) (setq po-start-of-entry (point))) ;; This is the first entry in the file. (setq po-start-of-entry (point-min))))) ;; The cursor was before msgstr in the first entry in the file. (goto-char (point-min)) (setq po-start-of-entry (point)) (if (re-search-forward po-any-msgstr-regexp nil t) (progn (setq po-middle-of-entry (match-beginning 0)) (setq po-end-of-entry (match-end 0))) ;; In fact, there is absolutely no entry in the file. (goto-char here) (error "No entries"))) (goto-char here)) (setq po-obsolete-flag (eq (char-after po-middle-of-entry) ?#))) ;;; 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 "The location stack is now empty")) ((= depth 1) (message "The location stack has one entry")) (t (message "The location stack contains %d entries" 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-middle-of-entry) (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-middle-of-entry) (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-empty-msgstr-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-empty-msgstr-regexp t)) (defun po-previous-untranslated-entry () "Find the previous untranslated entry, wrapping around if necessary." (interactive) (po-previous-entry-with-regexp po-empty-msgstr-regexp t)) ;; 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)) ;; Inexact translations. (defvar po-inexact-regexp "^#! INEXACT" "Regexp matching the string inserted by msgmerge for translations which does not match exactly.") (defun po-next-inexact () "Find the next inexact entry, wrapping around if necessary." (interactive) (po-next-entry-with-regexp po-inexact-regexp t)) (defun po-previous-inexact () "Find the next inexact entry, wrapping around if necessary." (interactive) (po-previous-entry-with-regexp po-inexact-regexp t)) ;;; Killing and yanking fields. (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-check-lock) (save-excursion (set-buffer po-work-buffer) (erase-buffer) (insert string) (kill-region (point-min) (point-max))))) (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-check-lock) (save-excursion (set-buffer po-work-buffer) (erase-buffer) (insert-buffer-substring buffer start end) (goto-char (point-min)) (search-forward "\"") (delete-region (point-min) (point)) (goto-char (point-max)) (search-backward "\"") (delete-region (point) (point-max)) (goto-char (point-min)) (while (re-search-forward "\"[ \t]*\\\\?\n#?[ \t]*\"" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (re-search-forward "\\\\[\\\"abfnt\\\\]" 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)))) (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-check-lock) (save-excursion (set-buffer po-work-buffer) (erase-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)) (insert "# ") (while (and (search-forward "\n" nil t) (not (eobp))) (insert "# ")))) (buffer-string)))) (defun po-get-field (msgid kill) "Extract and return the unquoted msgstr string, unless MSGID selects msgid. If KILL, then add the unquoted string to the kill ring." (let ((string (if msgid (progn (save-excursion (goto-char po-start-of-entry) (re-search-forward po-any-msgid-regexp po-end-of-entry t)) (po-extract-unquoted (current-buffer) (match-beginning 0) (match-end 0))) (po-extract-unquoted (current-buffer) po-middle-of-entry po-end-of-entry)))) (if kill (po-kill-new string)) string)) (defun po-set-field (msgid form) "Replace the current msgstr, unless MSGID, using FORM to get a string. If MSGID is true, replace the current msgid instead. In either case, 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." (let ((string (po-eval-requoted form (if msgid "msgid" "msgstr") po-obsolete-flag))) (save-excursion (goto-char po-start-of-entry) (re-search-forward (if msgid po-any-msgid-regexp po-any-msgstr-regexp) po-end-of-entry) (if (not (string-equal (buffer-substring (match-beginning 0) (match-end 0)) string)) (let ((buffer-read-only nil)) (replace-match string t t) (setq po-offer-validation t))) (if msgid (progn (re-search-forward po-any-msgstr-regexp) (setq po-middle-of-entry (match-beginning 0)) (setq po-end-of-entry (match-end 0))) (setq po-end-of-entry (point))))) (po-redisplay)) (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-field nil 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-field nil "") (po-redisplay)) (defun po-yank-msgstr () "Replace the current msgstr string by the top of the kill ring." (interactive) (po-find-span-of-entry) (po-set-field nil (if (eq last-command 'yank) '(yank-pop 1) '(yank))) (setq this-command 'yank) (po-redisplay)) (defun po-msgid-to-msgstr () "Replace the current msgstr with a copy of the msgid string." (interactive) (po-find-span-of-entry) (po-set-field nil (po-get-field t nil)) (po-redisplay)) (defun po-fade-out-entry () "Obsolete an active entry, or completely delete an obsolete entry. When an entry is completely deleted, its msgstr is put on the kill ring." (interactive) (po-check-lock) (po-find-span-of-entry) (if po-obsolete-flag (progn (po-get-field nil t) (let ((buffer-read-only nil)) (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)) (save-excursion (save-restriction (narrow-to-region po-start-of-entry po-end-of-entry) (let ((buffer-read-only nil)) (goto-char (point-min)) (while (not (eobp)) (or (eq (following-char) ?\n) (insert "# ")) (search-forward "\n"))))) (setq po-obsolete-flag t))) ;;; 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." (po-check-lock) (let ((buffer (current-buffer)) (obsolete po-obsolete-flag)) (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) (progn (set-buffer po-work-buffer) (erase-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." (po-check-lock) (let ((buffer (current-buffer)) (obsolete po-obsolete-flag) string) (save-excursion (set-buffer po-work-buffer) (erase-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 (and (re-search-forward (if obsolete po-obsolete-comment-regexp po-active-comment-regexp) po-end-of-entry t) (not (string-equal (buffer-substring (match-beginning 0) (match-end 0)) string))) (let ((buffer-read-only nil)) (replace-match string t t)) (skip-chars-forward " \t\n") (let ((buffer-read-only nil)) (insert string)))) (re-search-forward po-any-msgstr-regexp) (setq po-middle-of-entry (match-beginning 0)) (setq po-end-of-entry (match-end 0)) (po-redisplay)) (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 translations. (defun po-edit-string (string) "Edit STRING recursively in a pop-up buffer, return the edited string. If recursive edit is aborted, return nil instead." (po-check-lock) (let ((po-work-buffer-lock t) (start po-start-of-entry) (middle po-middle-of-entry) (end po-end-of-entry) (obsolete po-obsolete-flag)) (prog1 (save-window-excursion (pop-to-buffer po-work-buffer) (erase-buffer) (insert string "<") (goto-char (point-min)) (condition-case nil (progn (use-local-map po-edit-mode-map) (message "Type `C-c C-c' once done") (recursive-edit) (goto-char (point-max)) (skip-chars-backward " \t\n") (if (eq (preceding-char) ?<) (delete-region (1- (point)) (point-max))) (buffer-string)) (quit nil))) (bury-buffer po-work-buffer) (setq po-start-of-entry start) (setq po-middle-of-entry middle) (setq po-end-of-entry end) (setq po-obsolete-flag obsolete)))) (defun po-edit-comment () "Use another window to edit the current msgstr." (interactive) (po-find-span-of-entry) ; ;; Try showing all of msgid in the upper window while editing. ; (goto-char po-start-of-entry) ; (re-search-forward po-any-msgid-regexp) ; (backward-char 1) ; (recenter -1) (let ((string (po-edit-string (po-get-comment nil)))) (and string (po-set-comment string)) (po-redisplay))) (defun po-edit-msgstr () "Use another window to edit the current msgstr." (interactive) (po-find-span-of-entry) ; ;; Try showing all of msgid in the upper window while editing. ; (goto-char po-start-of-entry) ; (re-search-forward po-any-msgid-regexp) ; (backward-char 1) ; (recenter -1) (let ((string (po-edit-string (po-get-field nil nil)))) (and string (po-set-field nil string)) (po-redisplay))) ;;; String normalization and searching. (defun po-normalize-old-style (explain) "Normalize old gettext style fields using K&R C multiline string syntax." (let ((here (point-marker)) (counter 0) (buffer-read-only nil)) (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 (msgid explain) "Normalize all msgstr's, or msgid's if MSGID." (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) (po-set-field msgid (po-get-field msgid nil)) (goto-char po-end-of-entry) (setq counter (1+ counter))) (goto-char here) (message "Normalizing %d...done" counter))) (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 nil)) (kill-region po-end-of-entry (point-max))))) ;;; Original C sources as context. (defun po-show-path () "Echo the current source search path in the message area." (let ((path po-search-path) (string "Path is:")) (while path (setq string (concat string " " (car (car path)))) (setq path (cdr path))) (message string))) (defun po-add-path (directory) "Add a given DIRECTORY, requested interactively, to the source search path." (interactive "DDirectory for search path: ") (setq po-search-path (cons (list directory) po-search-path)) (setq po-reference-check 0) (po-show-path)) (defun po-delete-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-path)) (defun po-ensure-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-end-of-entry t) (while (looking-at "\\(\n#:\\)? *\\([^: ]+\\):\\([0-9]+\\)") (goto-char (match-end 0)) (let* ((name (buffer-substring (match-beginning 2) (match-end 2))) (line (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)) (setq po-reference-cursor po-reference-alist) (setq 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) ;; FIXME: Say position in cycle. But see po-select-reference first. (message "Displaying %s" (car triplet))) (defun po-cycle-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-references) (if po-reference-cursor (progn (if (eq last-command 'po-cycle-reference) (progn (setq po-reference-cursor (cdr po-reference-cursor)) (or po-reference-cursor (setq po-reference-cursor po-reference-alist)))) (po-show-source-context (car po-reference-cursor))) (error "No resolved source references"))) (defun po-select-reference () "Select one of the available source contexts for the current entry." (interactive) (po-ensure-references) (if po-reference-alist ;; FIXME: Instead, reset reference cursor, then use po-cycle-reference. (po-show-source-context (assoc (completing-read "Which source context? " po-reference-alist nil t) po-reference-alist)) (error "No resolved source references"))) ;;; C sources strings though tags table. (defun po-tags-search (restart) (interactive "P") "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." ;; 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) (while (not found) ;; Reinitialize the source file list if necessary. (if (not po-next-file-list) (progn (setq po-next-file-list (save-excursion (require 'etags) (next-file t) (or next-file-list (error "No files to process")))) (setq po-string-end nil))) ;; Try finding a string after resuming the search position. (message "Scanning %s..." (car po-next-file-list)) (save-excursion (setq end po-string-end) (setq buffer (find-file-noselect (car po-next-file-list))) (set-buffer buffer) (or end (setq end (point-min))) (goto-char end) (setq start nil) (while (and (not start) (re-search-forward "\\([\"']\\|/\\*\\)" nil t)) (cond ((= (preceding-char) ?*) ;; Disregard comments. (progn (search-forward "*/") (setq end (point)))) ((= (preceding-char) ?\') ;; Disregard character constants. (progn (forward-char (if (= (following-char) ?\\) 3 2)) (setq end (point)))) ((save-excursion (beginning-of-line) (looking-at "^# *\\(include\\|line\\)")) ;; Disregard lines being #include or #line directives. (progn (end-of-line) (setq end (point)))) ;; 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. (if (and (progn (goto-char start) (skip-chars-backward " \n\t") (= (preceding-char) ?\()) (let (end-keyword) (backward-char 1) (skip-chars-backward " \n\t") (setq end-keyword (point)) (skip-chars-backward "A-Za-z0-9_") (member (list (buffer-substring (point) end-keyword)) keywords))) ;; Disregard already marked strings. (setq start nil)) (goto-char end))))) (setq po-string-end end) ;; Advance to next file if no string was found. (if (not start) (progn (setq po-next-file-list (cdr po-next-file-list)) (if (not po-next-file-list) (error "All files processed")) (setq po-string-end nil)) ;; Push the string just found string into the work buffer for study. (po-extract-unquoted buffer start end) (save-excursion (set-buffer po-work-buffer) (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) (recenter 1) (if (pos-visible-in-window-p end) (goto-char end) (goto-char end) (recenter -1)) (other-window 1) ;; Save the string for later commands. (message "Scanning %s...done" (car po-next-file-list)) (setq po-string-start start) (setq po-string-end end))) (defun po-mark-found-string (keyword) "Mark last found string in C sources as translatable, using KEYWORD." (let ((buffer (find-file-noselect (car po-next-file-list))) (start po-string-start) (end po-string-end) line string) ;; Mark string in C sources. (setq string (po-extract-unquoted buffer start end)) (save-excursion (set-buffer buffer) (setq line (count-lines (point-min) start)) (goto-char end) (insert ")") (goto-char start) (insert keyword) (if (not (string-equal keyword "_")) (progn (insert " ") (setq end (1+ end)))) (insert "(")) (setq end (+ end 2 (length keyword))) (setq po-string-end end) ;; Add PO file entry. (let ((buffer-read-only nil)) (goto-char (point-max)) (insert "\n" (format "#: %s:%d\n" (car po-next-file-list) line) (po-eval-requoted string "msgid" nil) "msgstr \"\"\n") (previous-line 1) (setq po-offer-validation t)))) (defun po-mark-translatable () (interactive) "Mark last found string in C sources as translatable, using _()." (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) (interactive "P") "Mark last found string in C 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." (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-check-lock) (save-window-excursion (switch-to-buffer po-work-buffer) (erase-buffer) (insert po-help-display-string) (delete-other-windows) (goto-char (point-min)) (message "Type any character to continue") (read-char)) (bury-buffer po-work-buffer)) (defun po-undo () "Undo the last change to the PO file." (interactive) (let ((buffer-read-only nil)) (undo) (setq po-offer-validation t))) (defun po-statistics () "Say how many entries in each category, and the current position." (interactive) (po-find-span-of-entry) (let ((current 0) (total 0) (untranslated 0) (obsolete 0) here) (save-excursion (goto-char (point-min)) (while (re-search-forward po-any-msgstr-regexp nil t) (if (= (% total 20) 0) (message "Position %d/%d" current total)) (setq here (point)) (goto-char (match-beginning 0)) (setq total (1+ total)) (if (eq (point) po-middle-of-entry) (setq current total)) (if (eq (following-char) ?#) (setq obsolete (1+ obsolete)) (if (looking-at po-empty-msgstr-regexp) (setq untranslated (1+ untranslated)))) (goto-char here))) (message "Position %d/%d, with %d untranslated, %d obsolete" current total untranslated obsolete))) (defun po-validate () "Use `msgfmt' for validating the current PO file contents." (interactive) (setq po-offer-validation nil) ;; The following `let' is to protect the previous value of compile-command. (let ((compile-command (concat po-msgfmt-program " -o /dev/null " buffer-file-name))) (compile compile-command))) (defun po-quit () "Save the PO file and kill buffer. However, offer validation if appropriate and ask confirmation if untranslated strings remain." (interactive) (let ((quit t)) ;; Offer validation of newly modified entries. (if (and po-offer-validation (not (y-or-n-p "\ Some entries were newly modified... Skip validation step? "))) (progn (message "") (setq quit nil) (po-validate))) ;; Offer to work on untranslate entries. (if (and quit (save-excursion (goto-char (point-min)) (re-search-forward po-empty-msgstr-regexp nil t)) (not (y-or-n-p "\ Some untranslated entries remain... Quit anyway? "))) (progn (setq quit nil) (po-next-untranslated-entry))) ;; Clear message area (message nil) ;; Or else, kill buffer and quit for true. (if quit (progn (save-buffer) (kill-buffer po-work-buffer) (kill-buffer (current-buffer)))))) ;;; po-mode.el ends here