home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gettext-0.10.24-src.tgz / tar.out / fsf / gettext / misc / po-mode.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  63KB  |  1,837 lines
  1. ;;; po-mode.el -- for helping GNU gettext lovers to edit PO files.
  2. ;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
  3. ;;; François Pinard <pinard@iro.umontreal.ca>, 1995.
  4. ;;; Helped by Greg McGary <gkm@magilla.cichlid.com>.
  5.  
  6. ;; This file is part of GNU gettext.
  7.  
  8. ;; GNU gettext is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; GNU gettext is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20. ;; Free Software Foundation, 59 Temple Place - Suite 330, Boston,
  21. ;; MA 02111-1307, USA.
  22.  
  23. ;;; This package provides the tools meant to help editing PO files,
  24. ;;; as documented in the GNU gettext user's manual.  See this manual
  25. ;;; for user documentation, which is not repeated here.
  26.  
  27. ;;; To install, merely put this file somewhere GNU Emacs will find it,
  28. ;;; then add the following lines to your .emacs file:
  29. ;;;
  30. ;;;   (setq auto-mode-alist
  31. ;;;         (cons (cons "\\.po[tx]?\\'\\|\\.po\\." 'po-mode) auto-mode-alist))
  32. ;;;   (autoload 'po-mode "po-mode")
  33. ;;;
  34. ;;; You may also adjust some customizations variables, below, by defining
  35. ;;; them in your .emacs file.
  36.  
  37. (defvar po-auto-edit-with-msgid nil
  38.   "*Automatically use msgid when editing untranslated entries.")
  39.  
  40. (defvar po-auto-fuzzy-on-edit nil
  41.   "*Automatically mark entries fuzzy when being edited.")
  42.  
  43. (defvar po-auto-select-on-unfuzzy nil
  44.   "*Automatically select some new entry while make an entry not fuzzy.")
  45.  
  46. (defvar po-auto-replace-revision-date 'ask
  47.   "*Automatically revise date in headers.  Value is nil, t, or ask.")
  48.  
  49. (defvar po-default-file-header "\
  50. # SOME DESCRIPTIVE TITLE.
  51. # Copyright (C) YEAR Free Software Foundation, Inc.
  52. # FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
  53. #
  54. #, fuzzy
  55. msgid \"\"
  56. msgstr \"\"
  57. \"Project-Id-Version: PACKAGE VERSION\\n\"
  58. \"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n\"
  59. \"Last-Translator: FULL NAME <EMAIL@ADDRESS>\\n\"
  60. \"Language-Team: LANGUAGE <LL@li.org>\\n\"
  61. \"MIME-Version: 1.0\\n\"
  62. \"Content-Type: text/plain; charset=CHARSET\\n\"
  63. \"Content-Transfer-Encoding: ENCODING\\n\"
  64. "
  65.   "*Default PO file header.")
  66.  
  67. ;;;; The following block of declarations has the main purpose of avoiding
  68. ;;;; byte compiler warnings.  It also introduces some documentation for
  69. ;;;; each of these variables, all meant to be local to PO mode buffers.
  70.  
  71. ;; Flag telling that MODE-LINE-STRING should be displayed.  See `Window'
  72. ;; page below.  Exceptionally, this variable is local to *all* buffers.
  73.  
  74. (defvar po-mode-flag)
  75.  
  76. ;; The current entry extends from START-OF-ENTRY to END-OF-ENTRY, and
  77. ;; the line containing the msgstr keyword line starts at MIDDLE-OF-ENTRY.
  78. ;; ENTRY-TYPE classifies the entry.
  79.  
  80. (defvar po-start-of-entry)
  81. (defvar po-middle-of-entry)
  82. (defvar po-end-of-entry)
  83. (defvar po-entry-type)
  84.  
  85. ;; A few counters are usefully shown in the Emacs mode line.
  86.  
  87. (defvar po-translated-counter)
  88. (defvar po-fuzzy-counter)
  89. (defvar po-untranslated-counter)
  90. (defvar po-obsolete-counter)
  91. (defvar po-mode-line-string)
  92.  
  93. ;; A WORK-BUFFER is associated with this PO file, for edition and other
  94. ;; various tasks.  WORK-BUFFER-LOCK indicates that the work buffer
  95. ;; is already in use, most probably editing some string through Emacs
  96. ;; recursive edit.  In this case, one cannot modify the buffer.
  97.  
  98. (defvar po-work-buffer)
  99. (defvar po-work-buffer-lock)
  100.  
  101. ;; We maintain a set of movable pointers for returning to entries.
  102.  
  103. (defvar po-marker-stack)
  104.  
  105. ;; SEARCH path contains a list of directories where files may be found,
  106. ;; in a format suitable for read completion.  Each directory includes
  107. ;; its trailing slash.  PO mode starts with "./" and "../".
  108.  
  109. (defvar po-search-path)
  110.  
  111. ;; The following variables are meaningful only when REFERENCE-CHECK
  112. ;; is identical to START-OF-ENTRY, else they should be recomputed.
  113. ;; REFERENCE-ALIST contains all known references for the current
  114. ;; entry, each list element is (PROMPT FILE LINE), where PROMPT may
  115. ;; be used for completing read, FILE is a string and LINE is a number.
  116. ;; REFERENCE-CURSOR is a cycling cursor into REFERENCE-ALIST.
  117.  
  118. (defvar po-reference-alist)
  119. (defvar po-reference-cursor)
  120. (defvar po-reference-check)
  121.  
  122. ;; The following variables are for marking translatable strings in
  123. ;; program sources.  KEYWORDS is the list of keywords for marking
  124. ;; translatable strings, kept in a format suitable for reading with
  125. ;; completion.  NEXT-FILE-LIST is the list of source files to visit,
  126. ;; gotten from the tags table.  STRING-START is the position for
  127. ;; the beginning of the last found string, or nil if the string is
  128. ;; invalidated.  STRING-END is the position for the end of the string
  129. ;; and indicates where the search should be resumed, or nil for the
  130. ;; beginning of the current file.
  131.  
  132. (defvar po-keywords)
  133. (defvar po-next-file-list)
  134. (defvar po-string-start)
  135. (defvar po-string-end)
  136.  
  137. ;;; PO mode variables and constants (usually not to customize).
  138.  
  139. (eval-and-compile
  140.   (or (fboundp 'gettext) (defsubst gettext (string) string)))
  141. (defsubst _ (string) (gettext string))
  142. (defsubst N_ (string) string)
  143.  
  144. (defun po-mode-version ()
  145.   "Show Emacs PO mode version."
  146.   (interactive)
  147.   (message (_"Emacs PO mode, version %s") (substring "$Revision: 1.36 $" 11 -2)))
  148.  
  149. (defvar po-help-display-string
  150.   (_"\
  151.   [PO Mode Summary]       Next Previous            Miscellaneous
  152.                           n    p    Any type       .     Redisplay
  153. Moving around             /t   /M-t Translated     /v    Version info
  154. <    First if any         f    M-f  Fuzzy          ?, h  This help
  155. >    Last if any          o    M-o  Obsolete       =     Current index
  156. /SPC Auto select          u    M-u  Untranslated   O     Other window
  157.                                                    V     Validate
  158.                         Msgstr Comments            Q     Quit
  159. Modifying entries         RET  #    Call editor    U     Undo
  160. TAB   Remove fuzzy mark   k    K    Kill to        E    Edit out full
  161. /DEL  Fuzzy or fade out   w    W    Copy to
  162. LFD   Init with msgid     y    Y    Yank from        [*: Later, /: Docum]
  163.  
  164. gettext Keyword Marking                            Position Stack
  165. ,    Find next string     Compendiums              m  Mark and push current
  166. M-,  Mark translatable    *c    To compendium      r  Pop and return
  167. M-.  Change mark, mark    *M-C  Select, save       x  Exchange current/top
  168.  
  169. Program Sources           Auxiliary Files          Lexicography
  170. s    Cycle reference      *a    Cycle file         *l    Lookup translation
  171. M-s  Select reference     *M-a  Select file        *M-l  Add/edit translation
  172. S    Consider path        *A    Consider file      *L    Consider lexicon
  173. M-S  Ignore path          *M-A  Ignore file        *M-L  Ignore lexicon
  174. "))
  175.  
  176. (defvar po-any-msgid-regexp
  177.   "^\\(#~?[ \t]*\\)?msgid.*\n\\(\\(#~?[ \t]*\\)?\".*\n\\)*"
  178.   "Regexp matching a whole msgid field, whether obsolete or not.")
  179.  
  180. (defvar po-any-msgstr-regexp
  181.   "^\\(#~?[ \t]*\\)?msgstr.*\n\\(\\(#~?[ \t]*\\)?\".*\n\\)*"
  182.   "Regexp matching a whole msgstr field, whether obsolete or not.")
  183.  
  184. (defvar po-msgfmt-program "msgfmt"
  185.   "Path to msgfmt program from GNU gettext package.")
  186.  
  187. ;; Font lock based highlighting code.
  188. (defconst po-font-lock-keywords
  189.   '(
  190.     ("^\\(msgid \\|msgstr \\)?\"\\|\"$" . font-lock-keyword-face)
  191.     ("[%\\\\]." . font-lock-variable-name-face)
  192.     ("^# .*\\|^#[:,]?" . font-lock-comment-face)
  193.     ("^#:\\(.*\\)" 1 font-lock-reference-face)
  194.     ;; The following line does not work, and I wonder why.
  195.     ;;("^#,\\(.*\\)" 1 font-function-name-reference-face)
  196.     )
  197.   "Additional expressions to highlight in PO mode.")
  198.  
  199. ;; Old activator for `font lock'.  Is it still useful?  I don't think so.
  200. ;;
  201. ;;(if (boundp 'font-lock-keywords)
  202. ;;    (put 'po-mode 'font-lock-keywords 'po-font-lock-keywords))
  203.  
  204. ;; `hilit19' based hilighting code has been disabled, as most probably
  205. ;; nobody really needs it (it also generates ugly byte-compiler warnings).
  206. ;;
  207. ;;(if (fboundp 'hilit-set-mode-patterns)
  208. ;;    (hilit-set-mode-patterns 'po-mode
  209. ;;                 '(("^# .*\\|^#$" nil comment)
  210. ;;                   ("^#[.,:].*" nil include)
  211. ;;                   ("^\\(msgid\\|msgstr\\) *\"" nil keyword)
  212. ;;                   ("^\"\\|\"$" nil keyword))))
  213.  
  214. ;;; Mode activation.
  215.  
  216. (defvar po-mode-map nil
  217.   "Keymap for PO mode.")
  218. (if po-mode-map
  219.     ()
  220.   ;; The following line because (make-sparse-keymap) does not work on Demacs.
  221.   (setq po-mode-map (make-keymap))
  222.   (suppress-keymap po-mode-map)
  223.   (define-key po-mode-map "\C-i" 'po-unfuzzy)
  224.   (define-key po-mode-map "\C-j" 'po-msgid-to-msgstr)
  225.   (define-key po-mode-map "\C-m" 'po-edit-msgstr)
  226.   (define-key po-mode-map " " 'po-auto-select-entry)
  227.   (define-key po-mode-map "?" 'po-help)
  228.   (define-key po-mode-map "#" 'po-edit-comment)
  229.   (define-key po-mode-map "," 'po-tags-search)
  230.   (define-key po-mode-map "." 'po-current-entry)
  231.   (define-key po-mode-map "<" 'po-first-entry)
  232.   (define-key po-mode-map "=" 'po-statistics)
  233.   (define-key po-mode-map ">" 'po-last-entry)
  234. ;;;;  (define-key po-mode-map "a" 'po-cycle-auxiliary)
  235. ;;;;  (define-key po-mode-map "c" 'po-save-entry)
  236.   (define-key po-mode-map "f" 'po-next-fuzzy-entry)
  237.   (define-key po-mode-map "h" 'po-help)
  238.   (define-key po-mode-map "k" 'po-kill-msgstr)
  239. ;;;;  (define-key po-mode-map "l" 'po-lookup-lexicons)
  240.   (define-key po-mode-map "m" 'po-push-location)
  241.   (define-key po-mode-map "n" 'po-next-entry)
  242.   (define-key po-mode-map "o" 'po-next-obsolete-entry)
  243.   (define-key po-mode-map "p" 'po-previous-entry)
  244.   (define-key po-mode-map "q" 'po-confirm-and-quit)
  245.   (define-key po-mode-map "r" 'po-pop-location)
  246.   (define-key po-mode-map "s" 'po-cycle-source-reference)
  247.   (define-key po-mode-map "t" 'po-next-translated-entry)
  248.   (define-key po-mode-map "u" 'po-next-untranslated-entry)
  249.   (define-key po-mode-map "v" 'po-mode-version)
  250.   (define-key po-mode-map "w" 'po-kill-ring-save-msgstr)
  251.   (define-key po-mode-map "x" 'po-exchange-location)
  252.   (define-key po-mode-map "y" 'po-yank-msgstr)
  253. ;;;;  (define-key po-mode-map "A" 'po-consider-auxiliary-file)
  254.   (define-key po-mode-map "E" 'po-edit-out-full)
  255.   (define-key po-mode-map "K" 'po-kill-comment)
  256. ;;;;  (define-key po-mode-map "L" 'po-consider-lexicon-file)
  257.   (define-key po-mode-map "O" 'po-other-window)
  258.   (define-key po-mode-map "Q" 'po-quit)
  259.   (define-key po-mode-map "S" 'po-consider-source-path)
  260.   (define-key po-mode-map "U" 'po-undo)
  261.   (define-key po-mode-map "V" 'po-validate)
  262.   (define-key po-mode-map "W" 'po-kill-ring-save-comment)
  263.   (define-key po-mode-map "Y" 'po-yank-comment)
  264.   (define-key po-mode-map "\177" 'po-fade-out-entry)
  265.   (define-key po-mode-map "\M-," 'po-mark-translatable)
  266.   (define-key po-mode-map "\M-." 'po-select-mark-and-mark)
  267. ;;;;  (define-key po-mode-map "\M-a" 'po-select-auxiliary)
  268. ;;;;  (define-key po-mode-map "\M-c" 'po-select-and-save-entry)
  269.   (define-key po-mode-map "\M-f" 'po-previous-fuzzy-entry)
  270. ;;;;  (define-key po-mode-map "\M-l" 'po-edit-lexicon-entry)
  271.   (define-key po-mode-map "\M-o" 'po-previous-obsolete-entry)
  272.   (define-key po-mode-map "\M-t" 'po-previous-translated-entry)
  273.   (define-key po-mode-map "\M-u" 'po-previous-untranslated-entry)
  274.   (define-key po-mode-map "\M-s" 'po-select-source-reference)
  275. ;;;;  (define-key po-mode-map "\M-A" 'po-ignore-auxiliary-file)
  276. ;;;;  (define-key po-mode-map "\M-L" 'po-ignore-lexicon-file)
  277.   (define-key po-mode-map "\M-S" 'po-ignore-source-path)
  278.   )
  279.  
  280. (defvar po-subedit-mode-map nil
  281.   "Keymap while editing a PO mode entry (or the full PO file).")
  282. (if po-subedit-mode-map
  283.     ()
  284.   (setq po-subedit-mode-map (make-sparse-keymap))
  285.   (define-key po-subedit-mode-map "\C-c\C-c" 'exit-recursive-edit))
  286.  
  287. (defun po-mode ()
  288.   "Major mode for translators when they edit PO files.
  289. Special commands:\\{po-mode-map}
  290. Turning on PO mode calls the value of the variable `po-mode-hook',
  291. if that value is non-nil.  Behaviour may be adjusted with
  292. variables po-auto-edit-with-msgid, po-auto-fuzzy-on-edit,
  293. po-auto-select-on-unfuzzy and po-auto-replace-revision-date."
  294.  
  295.   (interactive)
  296.   (kill-all-local-variables)
  297.   (setq major-mode 'po-mode)
  298.   (setq mode-name "PO")
  299.   (use-local-map po-mode-map)
  300.   (setq buffer-read-only t)
  301.  
  302.   (make-local-variable 'font-lock-defaults)
  303.   (setq font-lock-defaults '(po-font-lock-keywords t))
  304.  
  305.   (make-local-variable 'po-start-of-entry)
  306.   (make-local-variable 'po-middle-of-entry)
  307.   (make-local-variable 'po-end-of-entry)
  308.   (make-local-variable 'po-entry-type)
  309.  
  310.   (make-local-variable 'po-translated-counter)
  311.   (make-local-variable 'po-fuzzy-counter)
  312.   (make-local-variable 'po-untranslated-counter)
  313.   (make-local-variable 'po-obsolete-counter)
  314.   (make-local-variable 'po-mode-line-string)
  315.  
  316.   (setq po-mode-flag t)
  317.  
  318.   (po-check-file-header)
  319.   (po-compute-counters nil)
  320.  
  321.   (make-local-variable 'po-work-buffer)
  322.   (make-local-variable 'po-work-buffer-lock)
  323.   (setq po-work-buffer
  324.     (generate-new-buffer (concat "*Edit " (buffer-name nil) "*")))
  325.   (setq po-work-buffer-lock nil)
  326.  
  327.   (make-local-variable 'po-marker-stack)
  328.   (setq po-marker-stack nil)
  329.  
  330.   (make-local-variable 'po-search-path)
  331.   (setq po-search-path '(("./") ("../")))
  332.  
  333.   (make-local-variable 'po-reference-alist)
  334.   (make-local-variable 'po-reference-cursor)
  335.   (make-local-variable 'po-reference-check)
  336.   (setq po-reference-alist nil)
  337.   (setq po-reference-cursor nil)
  338.   (setq po-reference-check 0)
  339.  
  340.   (make-local-variable 'po-keywords)
  341.   (make-local-variable 'po-next-file-list)
  342.   (make-local-variable 'po-string-start)
  343.   (make-local-variable 'po-string-end)
  344.   (setq po-keywords '(("gettext") ("gettext_noop") ("_") ("N_")))
  345.   (setq po-next-file-list nil)
  346.   (setq po-string-start nil)
  347.   (setq po-string-end nil)
  348.  
  349.   (message (_"You may type `h' or `?' for a short PO mode reminder."))
  350.   (run-hooks 'po-mode-hook))
  351.  
  352. (defun po-mode-destroy-cleanup ()
  353.   "When destroying a PO mode buffer, kill editing buffer as well."
  354.   (and (string= mode-name "PO")
  355.        (bufferp po-work-buffer)
  356.        (kill-buffer po-work-buffer)))
  357.  
  358. (if (boundp 'kill-buffer-hook)
  359.     (add-hook 'kill-buffer-hook 'po-mode-destroy-cleanup))
  360.  
  361. ;;; Window management.
  362.  
  363. (make-variable-buffer-local 'po-mode-flag)
  364.  
  365. (defvar po-mode-line-entry '(po-mode-flag ("  " po-mode-line-string))
  366.   "Mode line format entry displaying MODE-LINE-STRING.")
  367.  
  368. ;; Insert MODE-LINE-ENTRY in mode line, but on first load only.
  369. (or (member po-mode-line-entry mode-line-format)
  370.     (let ((entry (member 'global-mode-string mode-line-format)))
  371.       (setcdr entry (cons po-mode-line-entry (cdr entry)))))
  372.  
  373. (defun po-update-mode-line-string ()
  374.   "Compute a new statistics string to display in mode line."
  375.   (setq po-mode-line-string
  376.     (concat (format "%dt" po-translated-counter)
  377.         (if (> po-fuzzy-counter 0)
  378.             (format "+%df" po-fuzzy-counter))
  379.         (if (> po-untranslated-counter 0)
  380.             (format "+%du" po-untranslated-counter))
  381.         (if (> po-obsolete-counter 0)
  382.             (format "+%do" po-obsolete-counter))))
  383.   (set-buffer-modified-p (buffer-modified-p)))
  384.  
  385. (defun po-type-counter ()
  386.   "Return the symbol name of the counter appropriate for the current entry."
  387.   (cond ((eq po-entry-type 'obsolete) 'po-obsolete-counter)
  388.     ((eq po-entry-type 'fuzzy) 'po-fuzzy-counter)
  389.     ((eq po-entry-type 'translated) 'po-translated-counter)
  390.     ((eq po-entry-type 'untranslated) 'po-untranslated-counter)
  391.     (t (error (_"Unknown entry type")))))
  392.  
  393. (defun po-decrease-type-counter ()
  394.   "Decrease the counter corresponding to the nature of the current entry."
  395.   (let ((counter (po-type-counter)))
  396.     (set counter (1- (eval counter)))))
  397.  
  398. (defun po-increase-type-counter ()
  399.   "Increase the counter corresponding to the nature of the current entry.
  400. Then, update the mode line counters."
  401.   (let ((counter (po-type-counter)))
  402.     (set counter (1+ (eval counter))))
  403.   (po-update-mode-line-string))
  404.  
  405. ;; Avoid byte compiler warnings.
  406. (defvar po-fuzzy-regexp)
  407. (defvar po-untranslated-regexp)
  408.  
  409. (defun po-compute-counters (flag)
  410.   "Prepare counters for mode line display.  If FLAG, also echo entry position."
  411.   (and flag (po-find-span-of-entry))
  412.   (setq po-translated-counter 0)
  413.   (setq po-fuzzy-counter 0)
  414.   (setq po-untranslated-counter 0)
  415.   (setq po-obsolete-counter 0)
  416.   (let ((position 0) (total 0) here)
  417.     (save-excursion
  418.       (goto-char (point-min))
  419.       (while (re-search-forward po-any-msgstr-regexp nil t)
  420.     (and (= (% total 20) 0)
  421.          (if flag
  422.          (message (_"Position %d/%d") position total)
  423.            (message (_"Position %d") total)))
  424.     (setq here (point))
  425.     (goto-char (match-beginning 0))
  426.     (setq total (1+ total))
  427.     (and flag (eq (point) po-middle-of-entry) (setq position total))
  428.     (cond ((eq (following-char) ?#)
  429.            (setq po-obsolete-counter (1+ po-obsolete-counter)))
  430.           ((looking-at po-untranslated-regexp)
  431.            (setq po-untranslated-counter (1+ po-untranslated-counter)))
  432.           (t (setq po-translated-counter (1+ po-translated-counter))))
  433.     (goto-char here))
  434.  
  435.       ;; Make another pass just for the fuzzy entries, kind of kludgey.
  436.       ;; Counts will be wrong if untranslated entries are fuzzy, yet this
  437.       ;; should not normally happen.
  438.       (goto-char (point-min))
  439.       (while (re-search-forward po-fuzzy-regexp nil t)
  440.     (setq po-fuzzy-counter (1+ po-fuzzy-counter)))
  441.       (setq po-translated-counter (- po-translated-counter po-fuzzy-counter)))
  442.  
  443.     ;; Push the results out.
  444.     (if flag
  445.     (message (_"\
  446. Position %d/%d; %d translated, %d fuzzy, %d untranslated, %d obsolete")
  447.          position total po-translated-counter po-fuzzy-counter
  448.          po-untranslated-counter po-obsolete-counter)
  449.       (message "")))
  450.   (po-update-mode-line-string))
  451.  
  452. (defun po-redisplay ()
  453.   "Redisplay the current entry."
  454.   (goto-char po-middle-of-entry))
  455.  
  456. (defun po-other-window ()
  457.   "Get the cursor into another window, out of PO mode."
  458.   (interactive)
  459.   (if (one-window-p t)
  460.       (progn
  461.     (split-window)
  462.     (switch-to-buffer (other-buffer)))
  463.     (other-window 1)))
  464.  
  465. (defun po-check-lock ()
  466.   "Ensure that GNU Emacs is not currently in recursive edit for PO mode."
  467.   (if po-work-buffer-lock
  468.       (progn
  469.     (pop-to-buffer po-work-buffer)
  470.     (if (y-or-n-p (_"Here is your current edit.  Do you wish to abort it? "))
  471.         (abort-recursive-edit)
  472.       (error (_"Type `C-c C-c' once done"))))))
  473.  
  474. (defun po-edit-out-full ()
  475.   "Go into recursive edit for editing the PO file in fundamental mode."
  476.   (interactive)
  477.   (if (yes-or-no-p (_"Should I let you edit the whole PO file? "))
  478.       (progn
  479.     (message (_"Type `C-c C-c' once done"))
  480.     (let ((buffer-read-only nil))
  481.       (fundamental-mode)
  482.       (use-local-map po-subedit-mode-map)
  483.       (recursive-edit)
  484.       (use-local-map nil)
  485.       (po-mode)))))
  486.  
  487. ;;; Processing the PO file header entry.
  488.  
  489. (defun po-check-file-header ()
  490.   "Create a missing PO mode file header, or replace an oldish one."
  491.   (save-excursion
  492.     (let ((buffer-read-only nil)
  493.       insert-flag end-of-header)
  494.       (goto-char (point-min))
  495.       (if (re-search-forward po-any-msgstr-regexp nil t)
  496.       (progn
  497.  
  498.         ;; There is at least one entry.
  499.         (goto-char (match-beginning 0))
  500.         (previous-line 1)
  501.         (setq end-of-header (match-end 0))
  502.         (if (looking-at "msgid \"\"\n")
  503.  
  504.         ;; There is indeed a PO file header.
  505.         (if (re-search-forward "\n\"PO-Revision-Date: "
  506.                        end-of-header t)
  507.             nil
  508.  
  509.           ;; This is an oldish header.  Replace it all.
  510.           (goto-char end-of-header)
  511.           (while (> (point) (point-min))
  512.             (previous-line 1)
  513.             (insert "#~ ")
  514.             (beginning-of-line))
  515.           (beginning-of-line)
  516.           (setq insert-flag t))
  517.  
  518.           ;; The first entry is not a PO file header, insert one.
  519.           (setq insert-flag t)))
  520.  
  521.     ;; Not a single entry found.
  522.     (setq insert-flag t))
  523.  
  524.       (goto-char (point-min))
  525.       (and insert-flag (insert po-default-file-header "\n")))))
  526.  
  527. (defun po-replace-revision-date ()
  528.   "Replace the revision date by current time in the PO file header."
  529.   (if (fboundp 'format-time-string)
  530.       (if (or (eq po-auto-replace-revision-date t)
  531.           (and (eq po-auto-replace-revision-date 'ask)
  532.            (y-or-n-p (_"May I set PO-Revision-Date? "))))
  533.       (save-excursion
  534.         (goto-char (point-min))
  535.         (if (re-search-forward "^\"PO-Revision-Date:.*" nil t)
  536.         (let ((buffer-read-only nil))
  537.           (replace-match (concat "\"PO-Revision-Date: "
  538.                      (format-time-string
  539.                       "%Y-%m-%d %H:%M %Z" (current-time))
  540.                      "\\n\"")
  541.                  t t))))
  542.     (message ""))
  543.     (message (_"PO-Revision-Date should be adjusted..."))))
  544.  
  545. ;;; Handling span of entry, entry type and entry attributes.
  546.  
  547. (defun po-find-span-of-entry ()
  548.   "Find the extent of the PO file entry where the cursor is.
  549. Set variables PO-START-OF-ENTRY, PO-MIDDLE-OF-ENTRY, PO-END-OF-ENTRY
  550. and PO-ENTRY-TYPE to meaningful values.  Decreasing priority of type
  551. interpretation is: obsolete, fuzzy, untranslated or translated."
  552.   (let ((here (point)))
  553.     (if (re-search-backward po-any-msgstr-regexp nil t)
  554.     (progn
  555.  
  556.       ;; After a backward match, (match-end 0) will not extend
  557.       ;; beyond point, in case point was *inside* the regexp.  We
  558.       ;; need a dependable (match-end 0), so we redo the match in
  559.       ;; the forward direction.
  560.       (re-search-forward po-any-msgstr-regexp)
  561.       (if (<= (match-end 0) here)
  562.           (progn
  563.  
  564.         ;; We most probably found the msgstr of the previous
  565.         ;; entry.  The current entry then starts just after
  566.         ;; its end, save this information just in case.
  567.         (setq po-start-of-entry (match-end 0))
  568.  
  569.         ;; However, it is also possible that we are located in
  570.         ;; the crumb after the last entry in the file.  If
  571.         ;; yes, we know the middle and end of last PO entry.
  572.         (setq po-middle-of-entry (match-beginning 0))
  573.         (setq po-end-of-entry (match-end 0))
  574.  
  575.         (if (re-search-forward po-any-msgstr-regexp nil t)
  576.             (progn
  577.  
  578.               ;; We definitely were not in the crumb.
  579.               (setq po-middle-of-entry (match-beginning 0))
  580.               (setq po-end-of-entry (match-end 0)))
  581.  
  582.           ;; We were in the crumb.  The start of the last PO
  583.           ;; file entry is the end of the previous msgstr if
  584.           ;; any, or else, the beginning of the file.
  585.           (goto-char po-middle-of-entry)
  586.           (setq po-start-of-entry
  587.             (if (re-search-backward po-any-msgstr-regexp nil t)
  588.                 (match-end 0)
  589.               (point-min)))))
  590.  
  591.         ;; The cursor was inside msgstr of the current entry.
  592.         (setq po-middle-of-entry (match-beginning 0))
  593.         (setq po-end-of-entry (match-end 0))
  594.         ;; The start of this entry is the end of the previous
  595.         ;; msgstr if any, or else, the beginning of the file.
  596.         (goto-char po-middle-of-entry)
  597.         (setq po-start-of-entry
  598.           (if (re-search-backward po-any-msgstr-regexp nil t)
  599.               (match-end 0)
  600.             (point-min)))))
  601.  
  602.       ;; The cursor was before msgstr in the first entry in the file.
  603.       (setq po-start-of-entry (point-min))
  604.       (goto-char po-start-of-entry)
  605.       ;; There is at least the PO file header, so this should match.
  606.       (re-search-forward po-any-msgstr-regexp)
  607.       (setq po-middle-of-entry (match-beginning 0))
  608.       (setq po-end-of-entry (match-end 0)))
  609.  
  610.     ;; Classify the entry.
  611.     (goto-char po-middle-of-entry)
  612.     (setq po-entry-type
  613.       (if (eq (following-char) ?#)
  614.           'obsolete
  615.         (goto-char po-start-of-entry)
  616.         (if (re-search-forward po-fuzzy-regexp po-middle-of-entry t)
  617.         'fuzzy
  618.           (goto-char po-middle-of-entry)
  619.           (if (looking-at po-untranslated-regexp)
  620.           'untranslated
  621.         'translated))))
  622.  
  623.     ;; Put the cursor back where it was.
  624.     (goto-char here)))
  625.  
  626. (defun po-add-attribute (name)
  627.   "Add attribute NAME to the current entry, unless it is already there."
  628.   (save-excursion
  629.     (let ((buffer-read-only nil))
  630.       (goto-char po-start-of-entry)
  631.       (if (re-search-forward "\n#[,!] .*" po-middle-of-entry t)
  632.       (save-restriction
  633.         (narrow-to-region (match-beginning 0) (match-end 0))
  634.         (goto-char (point-min))
  635.         (if (re-search-forward (concat "\\b" name "\\b") nil t)
  636.         nil
  637.           (goto-char (point-max))
  638.           (insert ", " name)))
  639.     (skip-chars-forward "\n")
  640.     (while (eq (following-char) ?#)
  641.       (next-line 1))
  642.     (insert "#, " name "\n")))))
  643.  
  644. (defun po-delete-attribute (name)
  645.   "Delete attribute NAME from the current entry, if any."
  646.   (save-excursion
  647.     (let ((buffer-read-only nil))
  648.       (goto-char po-start-of-entry)
  649.       (if (re-search-forward "\n#[,!] .*" po-middle-of-entry t)
  650.       (save-restriction
  651.         (narrow-to-region (match-beginning 0) (match-end 0))
  652.         (goto-char (point-min))
  653.         (if (re-search-forward
  654.          (concat "\\(\n#[,!] " name "$\\|, " name "$\\| " name ",\\)")
  655.          nil t)
  656.         (replace-match "" t t)))))))
  657.  
  658. ;;; Entry positionning.
  659.  
  660. (defun po-say-location-depth ()
  661.   "Tell how many entries in the entry location stack."
  662.   (let ((depth (length po-marker-stack)))
  663.     (cond ((= depth 0) (message (_"Empty location stack")))
  664.       ((= depth 1) (message (_"One entry in location stack")))
  665.       (t (message (_"%d entries in location stack") depth)))))
  666.  
  667. (defun po-push-location ()
  668.   "Stack the location of the current entry, for later return."
  669.   (interactive)
  670.   (po-find-span-of-entry)
  671.   (save-excursion
  672.     (goto-char po-middle-of-entry)
  673.     (setq po-marker-stack (cons (point-marker) po-marker-stack)))
  674.   (po-say-location-depth))
  675.  
  676. (defun po-pop-location ()
  677.   "Unstack a saved location, and return to the corresponding entry."
  678.   (interactive)
  679.   (if po-marker-stack
  680.       (progn
  681.     (goto-char (car po-marker-stack))
  682.     (setq po-marker-stack (cdr po-marker-stack))
  683.     (po-current-entry)
  684.     (po-say-location-depth))
  685.     (error (_"The entry location stack is empty"))))
  686.  
  687. (defun po-exchange-location ()
  688.   "Exchange the location of the current entry with the top of stack."
  689.   (interactive)
  690.   (if po-marker-stack
  691.       (progn
  692.     (po-find-span-of-entry)
  693.     (goto-char po-middle-of-entry)
  694.     (let ((location (point-marker)))
  695.       (goto-char (car po-marker-stack))
  696.       (setq po-marker-stack (cons location (cdr po-marker-stack))))
  697.     (po-current-entry)
  698.     (po-say-location-depth))
  699.     (error (_"The entry location stack is empty"))))
  700.  
  701. (defun po-current-entry ()
  702.   "Display the current entry."
  703.   (interactive)
  704.   (po-find-span-of-entry)
  705.   (po-redisplay))
  706.  
  707. (defun po-first-entry-with-regexp (regexp)
  708.   "Display the first entry in the file which msgstr matches REGEXP."
  709.   (let ((here (point)))
  710.     (goto-char (point-min))
  711.     (if (re-search-forward regexp nil t)
  712.     (progn
  713.       (goto-char (match-beginning 0))
  714.       (po-current-entry))
  715.       (goto-char here)
  716.       (error (_"There is no such entry")))))
  717.  
  718. (defun po-last-entry-with-regexp (regexp)
  719.   "Display the last entry in the file which msgstr matches REGEXP."
  720.   (let ((here (point)))
  721.     (goto-char (point-max))
  722.     (if (re-search-backward regexp nil t)
  723.     (po-current-entry)
  724.       (goto-char here)
  725.       (error (_"There is no such entry")))))
  726.  
  727. (defun po-next-entry-with-regexp (regexp wrap)
  728.   "Display the entry following the current entry which msgstr matches REGEXP.
  729. If WRAP is not nil, the search may wrap around the buffer."
  730.   (po-find-span-of-entry)
  731.   (let ((here (point)))
  732.     (goto-char po-end-of-entry)
  733.     (if (re-search-forward regexp nil t)
  734.     (progn
  735.       (goto-char (match-beginning 0))
  736.       (po-current-entry))
  737.       (if (and wrap
  738.            (progn
  739.          (goto-char (point-min))
  740.          (re-search-forward regexp po-start-of-entry t)))
  741.       (progn
  742.         (goto-char (match-beginning 0))
  743.         (po-current-entry)
  744.         (message (_"Wrapping around the buffer")))
  745.     (goto-char here)
  746.     (error (_"There is no such entry"))))))
  747.  
  748. (defun po-previous-entry-with-regexp (regexp wrap)
  749.   "Redisplay the entry preceding the current entry which msgstr matches REGEXP.
  750. If WRAP is not nil, the search may wrap around the buffer."
  751.   (po-find-span-of-entry)
  752.   (let ((here (point)))
  753.     (goto-char po-start-of-entry)
  754.     (if (re-search-backward regexp nil t)
  755.     (po-current-entry)
  756.       (if (and wrap
  757.            (progn
  758.          (goto-char (point-max))
  759.          (re-search-backward regexp po-end-of-entry t)))
  760.       (progn
  761.         (po-current-entry)
  762.         (message (_"Wrapping around the buffer")))
  763.     (goto-char here)
  764.     (error (_"There is no such entry"))))))
  765.  
  766. ;; Any entries.
  767.  
  768. (defun po-first-entry ()
  769.   "Display the first entry."
  770.   (interactive)
  771.   (po-first-entry-with-regexp po-any-msgstr-regexp))
  772.  
  773. (defun po-last-entry ()
  774.   "Display the last entry."
  775.   (interactive)
  776.   (po-last-entry-with-regexp po-any-msgstr-regexp))
  777.  
  778. (defun po-next-entry ()
  779.   "Display the entry following the current entry."
  780.   (interactive)
  781.   (po-next-entry-with-regexp po-any-msgstr-regexp nil))
  782.  
  783. (defun po-previous-entry ()
  784.   "Display the entry preceding the current entry."
  785.   (interactive)
  786.   (po-previous-entry-with-regexp po-any-msgstr-regexp nil))
  787.  
  788. ;; Untranslated entries.
  789.  
  790. (defvar po-after-entry-regexp
  791.   "\\(\\'\\|\\(#[ \t]*\\)?[^\"]\\)"
  792.   "Regexp which should be true after a full msgstr string matched.")
  793.  
  794. (defvar po-untranslated-regexp
  795.   (concat "^msgstr[ \t]*\"\"\n" po-after-entry-regexp)
  796.   "Regexp matching a whole msgstr field, but only if active and empty.")
  797.  
  798. (defun po-next-untranslated-entry ()
  799.   "Find the next untranslated entry, wrapping around if necessary."
  800.   (interactive)
  801.   (po-next-entry-with-regexp po-untranslated-regexp t))
  802.  
  803. (defun po-previous-untranslated-entry ()
  804.   "Find the previous untranslated entry, wrapping around if necessary."
  805.   (interactive)
  806.   (po-previous-entry-with-regexp po-untranslated-regexp t))
  807.  
  808. (defun po-msgid-to-msgstr ()
  809.   "Use another window to edit msgstr reinitialized with msgid."
  810.   (interactive)
  811.   (po-find-span-of-entry)
  812.   (if (or (eq po-entry-type 'untranslated)
  813.       (eq po-entry-type 'obsolete)
  814.       (y-or-n-p (_"Really loose previous translation? ")))
  815.       (progn
  816.     (po-decrease-type-counter)
  817.     (po-set-field nil (po-get-field t nil))
  818.     (po-current-entry)
  819.     (po-increase-type-counter)))
  820.   (message ""))
  821.  
  822. ;; Obsolete entries.
  823.  
  824. (defvar po-obsolete-msgstr-regexp
  825.   "^#~?[ \t]*msgstr.*\n\\(#~?[ \t]*\".*\n\\)*"
  826.   "Regexp matching a whole msgstr field of an obsolete entry.")
  827.  
  828. (defun po-next-obsolete-entry ()
  829.   "Find the next obsolete entry, wrapping around if necessary."
  830.   (interactive)
  831.   (po-next-entry-with-regexp po-obsolete-msgstr-regexp t))
  832.  
  833. (defun po-previous-obsolete-entry ()
  834.   "Find the previous obsolete entry, wrapping around if necessary."
  835.   (interactive)
  836.   (po-previous-entry-with-regexp po-obsolete-msgstr-regexp t))
  837.  
  838. ;; Fuzzy entries.
  839.  
  840. (defvar po-fuzzy-regexp "^#[,!] .*fuzzy"
  841.   "Regexp matching the string inserted by msgmerge for translations
  842. which does not match exactly.")
  843.  
  844. (defun po-next-fuzzy-entry ()
  845.   "Find the next fuzzy entry, wrapping around if necessary."
  846.   (interactive)
  847.   (po-next-entry-with-regexp po-fuzzy-regexp t))
  848.  
  849. (defun po-previous-fuzzy-entry ()
  850.   "Find the next fuzzy entry, wrapping around if necessary."
  851.   (interactive)
  852.   (po-previous-entry-with-regexp po-fuzzy-regexp t))
  853.  
  854. (defun po-unfuzzy ()
  855.   "Remove the fuzzy attribute for the current entry."
  856.   (interactive)
  857.   (po-find-span-of-entry)
  858.   (cond ((eq po-entry-type 'fuzzy)
  859.      (po-decrease-type-counter)
  860.      (po-delete-attribute "fuzzy")
  861.      (po-current-entry)
  862.      (po-increase-type-counter)))
  863.   (if po-auto-select-on-unfuzzy
  864.       (po-auto-select-entry))
  865.   (po-update-mode-line-string))
  866.  
  867. ;; Translated entries.
  868.  
  869. (defun po-next-translated-entry ()
  870.   "Find the next untranslated entry, wrapping around if necessary."
  871.   (interactive)
  872.   (if (= po-translated-counter 0)
  873.       (error (_"There is no such entry"))
  874.     (po-next-entry-with-regexp po-untranslated-regexp t)
  875.     (po-find-span-of-entry)
  876.     (while (not (eq po-entry-type 'translated))
  877.       (po-next-entry-with-regexp po-any-msgstr-regexp t)
  878.       (po-find-span-of-entry))))
  879.  
  880. (defun po-previous-translated-entry ()
  881.   "Find the previous untranslated entry, wrapping around if necessary."
  882.   (interactive)
  883.   (if (= po-translated-counter 0)
  884.       (error (_"There is no such entry"))
  885.     (po-previous-entry-with-regexp po-any-msgstr-regexp t)
  886.     (po-find-span-of-entry)
  887.     (while (not (eq po-entry-type 'translated))
  888.       (po-previous-entry-with-regexp po-untranslated-regexp t)
  889.     (po-find-span-of-entry))))
  890.  
  891. ;; Auto-selection feature.
  892.  
  893. (defun po-auto-select-entry ()
  894.   "Select the next entry having the same type as the current one.
  895. If none, wrap from the beginning of the buffer with another type,
  896. going from untranslated to fuzzy, and from fuzzy to obsolete.
  897. Plain translated entries are always disregarded unless there are
  898. no entries of the other types."
  899.   (interactive)
  900.   (po-find-span-of-entry)
  901.   (goto-char po-end-of-entry)
  902.   (if (and (= po-untranslated-counter 0)
  903.        (= po-fuzzy-counter 0)
  904.        (= po-obsolete-counter 0))
  905.  
  906.       ;; All entries are plain translated.  Next entry will do, or
  907.       ;; wrap around if there is none.
  908.       (if (re-search-forward po-any-msgstr-regexp nil t)
  909.       (goto-char (match-beginning 0))
  910.     (goto-char (point-min)))
  911.  
  912.     ;; If over a translated entry, look for an untranslated one first.
  913.     ;; Else, look for an entry of the same type first.
  914.     (let ((goal (if (eq po-entry-type 'translated)
  915.             'untranslated
  916.           po-entry-type)))
  917.       (while goal
  918.  
  919.     ;; Find an untranslated entry, or wrap up for a fuzzy entry.
  920.     (if (eq goal 'untranslated)
  921.         (if (and (> po-untranslated-counter 0)
  922.              (re-search-forward po-untranslated-regexp nil t))
  923.         (progn
  924.           (goto-char (match-beginning 0))
  925.           (setq goal nil))
  926.           (goto-char (point-min))
  927.           (setq goal 'fuzzy)))
  928.  
  929.     ;; Find a fuzzy entry, or wrap up for an obsolete entry.
  930.     (if (eq goal 'fuzzy)
  931.         (if (and (> po-fuzzy-counter 0)
  932.              (re-search-forward po-fuzzy-regexp nil t))
  933.         (progn
  934.           (goto-char (match-beginning 0))
  935.           (setq goal nil))
  936.           (goto-char (point-min))
  937.           (setq goal 'obsolete)))
  938.  
  939.     ;; Find an obsolete entry, or wrap up for an untranslated entry.
  940.     (if (eq goal 'obsolete)
  941.         (if (and (> po-obsolete-counter 0)
  942.              (re-search-forward po-obsolete-msgstr-regexp nil t))
  943.         (progn
  944.           (goto-char (match-beginning 0))
  945.           (setq goal nil))
  946.           (goto-char (point-min))
  947.           (setq goal 'untranslated))))))
  948.  
  949.   ;; Display this entry nicely.
  950.   (po-current-entry))
  951.  
  952. ;;; Killing and yanking fields.
  953.  
  954. (eval-and-compile
  955.   (if (fboundp 'kill-new)
  956.  
  957.       (fset 'po-kill-new (symbol-function 'kill-new))
  958.  
  959.     (defun po-kill-new (string)
  960.       "Push STRING onto the kill ring, for Emacs 18 where kill-new is missing."
  961.       (po-check-lock)
  962.       (save-excursion
  963.     (set-buffer po-work-buffer)
  964.     (erase-buffer)
  965.     (insert string)
  966.     (kill-region (point-min) (point-max))))))
  967.  
  968. (defun po-extract-unquoted (buffer start end)
  969.   "Extract and return the unquoted string in BUFFER going from START to END.
  970. Crumb preceding or following the quoted string is ignored."
  971.   (po-check-lock)
  972.   (save-excursion
  973.     (set-buffer po-work-buffer)
  974.     (erase-buffer)
  975.     (insert-buffer-substring buffer start end)
  976.     (goto-char (point-min))
  977.     (search-forward "\"")
  978.     (delete-region (point-min) (point))
  979.     (goto-char (point-max))
  980.     (search-backward "\"")
  981.     (delete-region (point) (point-max))
  982.     (goto-char (point-min))
  983.     ;; It seems that "\"[ \t]*\\\\?\n\(#~?\)?[ \t]*\"" would not work
  984.     ;; below, for some unknown reason.  Could it be a regexp bug?
  985.     (while (re-search-forward "\"[ \t]*\\\\?\n#?~?[ \t]*\"" nil t)
  986.       (replace-match "" t t))
  987.     (goto-char (point-min))
  988.     (while (re-search-forward "\\\\[\\\"abfnt\\\\0-7]" nil t)
  989.       (cond ((eq (preceding-char) ?\") (replace-match "\"" t t))
  990.         ((eq (preceding-char) ?a) (replace-match "\a" t t))
  991.         ((eq (preceding-char) ?b) (replace-match "\b" t t))
  992.         ((eq (preceding-char) ?f) (replace-match "\f" t t))
  993.         ((eq (preceding-char) ?n) (replace-match "\n" t t))
  994.         ((eq (preceding-char) ?t) (replace-match "\t" t t))
  995.         ((eq (preceding-char) ?\\) (replace-match "\\" t t))
  996.         (t (let ((value (- (preceding-char) ?0)))
  997.          (replace-match "" t t)
  998.          (while (looking-at "[0-7]")
  999.            (setq value (+ (* 8 value) (- (following-char) ?0)))
  1000.            (replace-match "" t t))
  1001.          (insert value)))))
  1002.     (buffer-string)))
  1003.  
  1004. (defun po-eval-requoted (form prefix obsolete)
  1005.   "Eval FORM, which inserts a string, and return the string fully requoted.
  1006. If PREFIX, precede the result with its contents.  If OBSOLETE, comment all
  1007. generated lines in the returned string.  Evaluating FORM should insert the
  1008. wanted string in the buffer which is current at the time of evaluation.
  1009. If FORM is itself a string, then this string is used for insertion."
  1010.   (po-check-lock)
  1011.   (save-excursion
  1012.     (set-buffer po-work-buffer)
  1013.     (erase-buffer)
  1014.     (if (stringp form)
  1015.     (insert form)
  1016.       (push-mark)
  1017.       (eval form))
  1018.     (goto-char (point-min))
  1019.     (let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t)))
  1020.       (goto-char (point-min))
  1021.       (while (re-search-forward "[\\\"\a\b\f\n\t\\\\]" nil t)
  1022.     (cond ((eq (preceding-char) ?\") (replace-match "\\\"" t t))
  1023.           ((eq (preceding-char) ?\a) (replace-match "\\a" t t))
  1024.           ((eq (preceding-char) ?\b) (replace-match "\\b" t t))
  1025.           ((eq (preceding-char) ?\f) (replace-match "\\f" t t))
  1026.           ((eq (preceding-char) ?\n)
  1027.            (replace-match (if (or (not multi-line) (eobp))
  1028.                   "\\n"
  1029.                 "\\n\"\n\"")
  1030.                   t t))
  1031.           ((eq (preceding-char) ?\t) (replace-match "\\t" t t))
  1032.           ((eq (preceding-char) ?\\) (replace-match "\\\\" t t))))
  1033.       (goto-char (point-min))
  1034.       (if prefix (insert prefix " "))
  1035.       (insert (if multi-line "\"\"\n\"" "\""))
  1036.       (goto-char (point-max))
  1037.       (insert "\"")
  1038.       (if prefix (insert "\n"))
  1039.       (if obsolete
  1040.       (progn
  1041.         (goto-char (point-min))
  1042.         (while (not (eobp))
  1043.           (or (eq (following-char) ?\n) (insert "#~ "))
  1044.           (search-forward "\n"))))
  1045.       (buffer-string))))
  1046.  
  1047. (defun po-get-field (msgid kill)
  1048.   "Extract and return the unquoted msgstr string, unless MSGID selects msgid.
  1049. If KILL, then add the unquoted string to the kill ring."
  1050.   (let ((string (if msgid
  1051.             (progn
  1052.               (save-excursion
  1053.             (goto-char po-start-of-entry)
  1054.             (re-search-forward po-any-msgid-regexp
  1055.                        po-end-of-entry t))
  1056.               (po-extract-unquoted (current-buffer)
  1057.                        (match-beginning 0) (match-end 0)))
  1058.           (po-extract-unquoted (current-buffer)
  1059.                        po-middle-of-entry po-end-of-entry))))
  1060.     (if kill (po-kill-new string))
  1061.     string))
  1062.  
  1063. (defun po-set-field (msgid form)
  1064.   "Replace the current msgstr, unless MSGID, using FORM to get a string.
  1065. If MSGID is true, replace the current msgid instead.  In either case,
  1066. evaluating FORM should insert the wanted string in the current buffer.
  1067. If FORM is itself a string, then this string is used for insertion.
  1068. The string is properly requoted before the replacement occurs."
  1069.   (or msgid (po-decrease-type-counter))
  1070.   (let ((string (po-eval-requoted form (if msgid "msgid" "msgstr")
  1071.                   (eq po-entry-type 'obsolete))))
  1072.     (save-excursion
  1073.       (goto-char po-start-of-entry)
  1074.       (re-search-forward (if msgid po-any-msgid-regexp po-any-msgstr-regexp)
  1075.              po-end-of-entry)
  1076.       (if (not (string-equal (buffer-substring (match-beginning 0)
  1077.                            (match-end 0))
  1078.                  string))
  1079.       (let ((buffer-read-only nil))
  1080.         (replace-match string t t)))
  1081.       (if msgid
  1082.       (progn
  1083.         (re-search-forward po-any-msgstr-regexp)
  1084.         (setq po-middle-of-entry (match-beginning 0))
  1085.         (setq po-end-of-entry (match-end 0)))
  1086.     (setq po-end-of-entry (point)))))
  1087.   (or msgid (po-increase-type-counter))
  1088.   (po-redisplay))
  1089.  
  1090. (defun po-kill-ring-save-msgstr ()
  1091.   "Push the msgstr string from current entry on the kill ring."
  1092.   (interactive)
  1093.   (po-find-span-of-entry)
  1094.   (po-get-field nil t))
  1095.  
  1096. (defun po-kill-msgstr ()
  1097.   "Empty the msgstr string from current entry, pushing it on the kill ring."
  1098.   (interactive)
  1099.   (po-kill-ring-save-msgstr)
  1100.   (po-decrease-type-counter)
  1101.   (po-set-field nil "")
  1102.   (po-current-entry)
  1103.   (po-increase-type-counter))
  1104.  
  1105. (defun po-yank-msgstr ()
  1106.   "Replace the current msgstr string by the top of the kill ring."
  1107.   (interactive)
  1108.   (po-find-span-of-entry)
  1109.   (po-decrease-type-counter)
  1110.   (po-set-field nil (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
  1111.   (po-current-entry)
  1112.   (po-increase-type-counter)
  1113.   (setq this-command 'yank))
  1114.  
  1115. (defun po-fade-out-entry ()
  1116.   "Mark an active entry as fuzzy; obsolete a fuzzy or untranslated entry;
  1117. or completely delete an obsolete entry, saving its msgstr on the kill ring."
  1118.   (interactive)
  1119.   (po-check-lock)
  1120.   (po-find-span-of-entry)
  1121.  
  1122.   (cond ((eq po-entry-type 'translated)
  1123.      (po-decrease-type-counter)
  1124.      (po-add-attribute "fuzzy")
  1125.      (po-current-entry)
  1126.      (po-increase-type-counter))
  1127.  
  1128.     ((or (eq po-entry-type 'fuzzy)
  1129.          (eq po-entry-type 'untranslated))
  1130.      (if (yes-or-no-p (_"Should I really obsolete this entry? "))
  1131.          (progn
  1132.            (po-decrease-type-counter)
  1133.            (save-excursion
  1134.          (save-restriction
  1135.            (narrow-to-region po-start-of-entry po-end-of-entry)
  1136.            (let ((buffer-read-only nil))
  1137.              (goto-char (point-min))
  1138.              (while (not (eobp))
  1139.                (or (eq (following-char) ?\n) (insert "#~ "))
  1140.                (search-forward "\n")))))
  1141.            (po-current-entry)
  1142.            (po-increase-type-counter)))
  1143.      (message ""))
  1144.  
  1145.     ((eq po-entry-type 'obsolete)
  1146.      (po-decrease-type-counter)
  1147.      (po-update-mode-line-string)
  1148.      (po-get-field nil t)
  1149.      (let ((buffer-read-only nil))
  1150.        (delete-region po-start-of-entry po-end-of-entry))
  1151.      (goto-char po-start-of-entry)
  1152.      (if (re-search-forward po-any-msgstr-regexp nil t)
  1153.          (goto-char (match-beginning 0))
  1154.        (re-search-backward po-any-msgstr-regexp nil t))
  1155.      (po-current-entry)
  1156.      (message ""))))
  1157.  
  1158. ;;; Killing and yanking comments.
  1159.  
  1160. (defvar po-active-comment-regexp
  1161.   "^\\(#\n\\|# .*\n\\)+"
  1162.   "Regexp matching the whole editable comment part of an active entry.")
  1163.  
  1164. (defvar po-obsolete-comment-regexp
  1165.   "^\\(#~? #\n\\|#~? # .*\n\\)+"
  1166.   "Regexp matching the whole editable comment part of an obsolete entry.")
  1167.  
  1168. (defun po-get-comment (kill-flag)
  1169.   "Extract and return the editable comment string, uncommented.
  1170. If KILL-FLAG, then add the unquoted comment to the kill ring."
  1171.   (po-check-lock)
  1172.   (let ((buffer (current-buffer))
  1173.     (obsolete (eq po-entry-type 'obsolete)))
  1174.     (save-excursion
  1175.       (goto-char po-start-of-entry)
  1176.       (if (re-search-forward (if obsolete po-obsolete-comment-regexp
  1177.                      po-active-comment-regexp)
  1178.                  po-end-of-entry t)
  1179.       (progn
  1180.         (set-buffer po-work-buffer)
  1181.         (erase-buffer)
  1182.         (insert-buffer-substring buffer (match-beginning 0) (match-end 0))
  1183.         (goto-char (point-min))
  1184.         (while (not (eobp))
  1185.           (if (looking-at (if obsolete "#~? # ?" "#~? ?"))
  1186.           (replace-match "" t t))
  1187.           (forward-line 1))
  1188.         (and kill-flag (copy-region-as-kill (point-min) (point-max)))
  1189.         (buffer-string))
  1190.     ""))))
  1191.  
  1192. (defun po-set-comment (form)
  1193.   "Using FORM to get a string, replace the current editable comment.
  1194. Evaluating FORM should insert the wanted string in the current buffer.
  1195. If FORM is itself a string, then this string is used for insertion.
  1196. The string is properly recommented before the replacement occurs."
  1197.   (po-check-lock)
  1198.   (let ((buffer (current-buffer))
  1199.     (obsolete (eq po-entry-type 'obsolete))
  1200.     string)
  1201.     (save-excursion
  1202.       (set-buffer po-work-buffer)
  1203.       (erase-buffer)
  1204.       (if (stringp form)
  1205.       (insert form)
  1206.     (push-mark)
  1207.     (eval form))
  1208.       (if (not (or (bobp) (= (preceding-char) ?\n)))
  1209.       (insert "\n"))
  1210.       (goto-char (point-min))
  1211.       (while (not (eobp))
  1212.     (insert (if (= (following-char) ?\n)
  1213.             (if obsolete "#~ #" "#")
  1214.           (if obsolete "#~ # " "# ")))
  1215.     (search-forward "\n"))
  1216.       (setq string (buffer-string)))
  1217.     (goto-char po-start-of-entry)
  1218.     (if (and (re-search-forward
  1219.           (if obsolete po-obsolete-comment-regexp po-active-comment-regexp)
  1220.           po-end-of-entry t)
  1221.          (not (string-equal
  1222.            (buffer-substring (match-beginning 0) (match-end 0))
  1223.            string)))
  1224.     (let ((buffer-read-only nil))
  1225.       (replace-match string t t))
  1226.       (skip-chars-forward " \t\n")
  1227.       (let ((buffer-read-only nil))
  1228.     (insert string))))
  1229.   (re-search-forward po-any-msgstr-regexp)
  1230.   (setq po-middle-of-entry (match-beginning 0))
  1231.   (setq po-end-of-entry (match-end 0))
  1232.   (po-redisplay))
  1233.  
  1234. (defun po-kill-ring-save-comment ()
  1235.   "Push the msgstr string from current entry on the kill ring."
  1236.   (interactive)
  1237.   (po-find-span-of-entry)
  1238.   (po-get-comment t))
  1239.  
  1240. (defun po-kill-comment ()
  1241.   "Empty the msgstr string from current entry, pushing it on the kill ring."
  1242.   (interactive)
  1243.   (po-kill-ring-save-comment)
  1244.   (po-set-comment "")
  1245.   (po-redisplay))
  1246.  
  1247. (defun po-yank-comment ()
  1248.   "Replace the current comment string by the top of the kill ring."
  1249.   (interactive)
  1250.   (po-find-span-of-entry)
  1251.   (po-set-comment (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
  1252.   (setq this-command 'yank)
  1253.   (po-redisplay))
  1254.  
  1255. ;;; Editing translations.
  1256.  
  1257. (defun po-edit-string (string)
  1258.   "Edit STRING recursively in a pop-up buffer, return the edited string.
  1259. Run po-subedit-mode-hook first prior to beginning edition.  If recursive edit
  1260. is aborted, return nil instead."
  1261.   (po-check-lock)
  1262.   (let ((po-work-buffer-lock t)
  1263.     (start po-start-of-entry)
  1264.     (middle po-middle-of-entry)
  1265.     (end po-end-of-entry)
  1266.     (obsolete (eq po-entry-type 'obsolete)))
  1267.     (prog1
  1268.     (save-window-excursion
  1269.       (pop-to-buffer po-work-buffer)
  1270.       (erase-buffer)
  1271.       (run-hooks 'po-subedit-mode-hook)
  1272.       (insert string "<")
  1273.       (goto-char (point-min))
  1274.       (condition-case nil
  1275.           (progn
  1276.         (use-local-map po-subedit-mode-map)
  1277.         (message (_"Type `C-c C-c' once done"))
  1278.         (recursive-edit)
  1279.         (goto-char (point-max))
  1280.         (skip-chars-backward " \t\n")
  1281.         (if (eq (preceding-char) ?<)
  1282.             (delete-region (1- (point)) (point-max)))
  1283.         (buffer-string))
  1284.         (quit nil)))
  1285.       (bury-buffer po-work-buffer))))
  1286.  
  1287. (defun po-edit-comment ()
  1288.   "Use another window to edit the current translator comment."
  1289.   (interactive)
  1290.   (po-find-span-of-entry)
  1291. ;  ;; Try showing all of msgid in the upper window while editing.
  1292. ;  (goto-char po-start-of-entry)
  1293. ;  (re-search-forward po-any-msgid-regexp)
  1294. ;  (backward-char 1)
  1295. ;  (recenter -1)
  1296.   (let ((string (po-edit-string (po-get-comment nil))))
  1297.     (and string (po-set-comment string))
  1298.     (po-redisplay)))
  1299.  
  1300. (defun po-edit-msgstr ()
  1301.   "Use another window to edit the current msgstr."
  1302.   (interactive)
  1303.   (po-find-span-of-entry)
  1304.   (and po-auto-edit-with-msgid
  1305.        (eq po-entry-type 'untranslated)
  1306.        (po-msgid-to-msgstr))
  1307.   ;; ;; Try showing all of msgid in the upper window while editing.
  1308.   ;; (goto-char po-start-of-entry)
  1309.   ;; (re-search-forward po-any-msgid-regexp)
  1310.   ;; (backward-char 1)
  1311.   ;; (recenter -1)
  1312.   (let ((string (po-edit-string (po-get-field nil nil))))
  1313.     (if string
  1314.     (progn
  1315.       (po-decrease-type-counter)
  1316.       (po-set-field nil string)
  1317.       (po-current-entry)
  1318.       (if (and po-auto-fuzzy-on-edit
  1319.            (eq po-entry-type 'translated))
  1320.           (progn
  1321.         (po-add-attribute "fuzzy")
  1322.         (po-current-entry)))
  1323.       (po-increase-type-counter)))))
  1324.  
  1325. ;;; String normalization and searching.
  1326.  
  1327. (defun po-normalize-old-style (explain)
  1328.   "Normalize old gettext style fields using K&R C multiline string syntax.
  1329. To minibuffer messages sent while normalizing, add the EXPLAIN string."
  1330.   (let ((here (point-marker))
  1331.     (counter 0)
  1332.     (buffer-read-only nil))
  1333.     (goto-char (point-min))
  1334.     (message (_"Normalizing %d, %s") counter explain)
  1335.     (while (re-search-forward
  1336.         "\\(^#?[ \t]*msg\\(id\\|str\\)[ \t]*\"\\|[^\" \t][ \t]*\\)\\\\\n"
  1337.         nil t)
  1338.       (if (= (% counter 10) 0)
  1339.       (message (_"Normalizing %d, %s") counter explain))
  1340.       (replace-match "\\1\"\n\"" t nil)
  1341.       (setq counter (1+ counter)))
  1342.     (goto-char here)
  1343.     (message (_"Normalizing %d...done") counter)))
  1344.  
  1345. (defun po-normalize-field (msgid explain)
  1346.   "Normalize all msgstr's, or msgid's if MSGID.
  1347. To minibuffer messages sent while normalizing, add the EXPLAIN string."
  1348.   (let ((here (point-marker))
  1349.     (counter 0))
  1350.     (goto-char (point-min))
  1351.     (while (re-search-forward po-any-msgstr-regexp nil t)
  1352.       (if (= (% counter 10) 0)
  1353.       (message (_"Normalizing %d, %s") counter explain))
  1354.       (goto-char (match-beginning 0))
  1355.       (po-find-span-of-entry)
  1356.       (po-set-field msgid (po-get-field msgid nil))
  1357.       (goto-char po-end-of-entry)
  1358.       (setq counter (1+ counter)))
  1359.     (goto-char here)
  1360.     (message (_"Normalizing %d...done") counter)))
  1361.  
  1362. (defun po-normalize ()
  1363.   "Normalize all entries in the PO file."
  1364.   (interactive)
  1365.   (po-normalize-old-style (_"pass 1/3"))
  1366.   (po-normalize-field t (_"pass 2/3"))
  1367.   (po-normalize-field nil (_"pass 3/3"))
  1368.   ;; The last PO file entry has just been processed.
  1369.   (if (not (= po-end-of-entry (point-max)))
  1370.       (let ((buffer-read-only nil))
  1371.     (kill-region po-end-of-entry (point-max))))
  1372.   ;; A bizarre format might have fooled the counters, so recompute
  1373.   ;; them to make sure their value is dependable.
  1374.   (po-compute-counters nil))
  1375.  
  1376. ;;; Original program sources as context.
  1377.  
  1378. (defun po-show-source-path ()
  1379.   "Echo the current source search path in the message area."
  1380.   (let ((path po-search-path)
  1381.     (string (_"Path is:")))
  1382.     (while path
  1383.       (setq string (concat string " " (car (car path))))
  1384.       (setq path (cdr path)))
  1385.     (message string)))
  1386.  
  1387. (defun po-consider-source-path (directory)
  1388.   "Add a given DIRECTORY, requested interactively, to the source search path."
  1389.   (interactive "DDirectory for search path: ")
  1390.   (setq po-search-path (cons (list directory) po-search-path))
  1391.   (setq po-reference-check 0)
  1392.   (po-show-source-path))
  1393.  
  1394. (defun po-ignore-source-path ()
  1395.   "Delete a directory, selected with completion, from the source search path."
  1396.   (interactive)
  1397.   (setq po-search-path
  1398.     (delete (list (completing-read (_"Directory to remove? ")
  1399.                        po-search-path nil t))
  1400.         po-search-path))
  1401.   (setq po-reference-check 0)
  1402.   (po-show-source-path))
  1403.  
  1404. (defun po-ensure-source-references ()
  1405.   "Extract all references into a list, with paths resolved, if necessary."
  1406.   (po-find-span-of-entry)
  1407.   (if (= po-start-of-entry po-reference-check)
  1408.       ()
  1409.     (setq po-reference-alist nil)
  1410.     (save-excursion
  1411.       (goto-char po-start-of-entry)
  1412.       (if (re-search-forward "^#:" po-middle-of-entry t)
  1413.       (while (looking-at "\\(\n#:\\)? *\\([^: ]+\\):\\([0-9]+\\)")
  1414.         (goto-char (match-end 0))
  1415.         (let* ((name (buffer-substring (match-beginning 2) (match-end 2)))
  1416.            (line (buffer-substring (match-beginning 3) (match-end 3)))
  1417.            (path po-search-path)
  1418.            file)
  1419.           (while (and (progn (setq file (concat (car (car path)) name))
  1420.                  (not (file-exists-p file)))
  1421.               path)
  1422.         (setq path (cdr path)))
  1423.           (if path
  1424.           (setq po-reference-alist
  1425.             (cons (list (concat file ":" line)
  1426.                     file
  1427.                     (string-to-int line))
  1428.                   po-reference-alist)))))))
  1429.     (setq po-reference-alist (nreverse po-reference-alist))
  1430.     (setq po-reference-cursor po-reference-alist)
  1431.     (setq po-reference-check po-start-of-entry)))
  1432.  
  1433. (defun po-show-source-context (triplet)
  1434.   "Show the source context given a TRIPLET which is (PROMPT FILE LINE)."
  1435.   (find-file-other-window (car (cdr triplet)))
  1436.   (goto-line (car (cdr (cdr triplet))))
  1437.   (other-window 1)
  1438.   (let ((maximum 0)
  1439.     position
  1440.     (cursor po-reference-alist))
  1441.     (while (not (eq triplet (car cursor)))
  1442.       (setq maximum (1+ maximum))
  1443.       (setq cursor (cdr cursor)))
  1444.     (setq position (1+ maximum))
  1445.     (setq po-reference-cursor cursor)
  1446.     (while cursor
  1447.       (setq maximum (1+ maximum))
  1448.       (setq cursor (cdr cursor)))
  1449.     (message (_"Displaying %d/%d: \"%s\"") position maximum (car triplet))))
  1450.  
  1451. (defun po-cycle-source-reference ()
  1452.   "Display some source context for the current entry.
  1453. If the command is repeated many times in a row, cycle through contexts."
  1454.   (interactive)
  1455.   (po-ensure-source-references)
  1456.   (if po-reference-cursor
  1457.       (po-show-source-context
  1458.        (car (if (eq last-command 'po-cycle-source-reference)
  1459.         (or (cdr po-reference-cursor) po-reference-alist)
  1460.           po-reference-cursor)))
  1461.     (error (_"No resolved source references"))))
  1462.  
  1463. (defun po-select-source-reference ()
  1464.   "Select one of the available source contexts for the current entry."
  1465.   (interactive)
  1466.   (po-ensure-source-references)
  1467.   (if po-reference-alist
  1468.       (po-show-source-context
  1469.        (assoc
  1470.     (completing-read (_"Which source context? ") po-reference-alist nil t)
  1471.     po-reference-alist))
  1472.     (error (_"No resolved source references"))))
  1473.  
  1474. ;;; Program sources strings though tags table.
  1475.  
  1476. ;;; C mode.
  1477.  
  1478. (defun po-find-c-string (keywords)
  1479.   "Find the next C string, excluding those marked by any of KEYWORDS.
  1480. Returns (START . END) for the found string, or (nil . nil) if none found."
  1481.   (let (start end)
  1482.     (while (and (not start)
  1483.         (re-search-forward "\\([\"']\\|/\\*\\)" nil t))
  1484.       (cond ((= (preceding-char) ?*)
  1485.          ;; Disregard comments.
  1486.          (search-forward "*/"))
  1487.  
  1488.         ((= (preceding-char) ?\')
  1489.          ;; Disregard character constants.
  1490.          (forward-char (if (= (following-char) ?\\) 3 2)))
  1491.  
  1492.         ((save-excursion
  1493.            (beginning-of-line)
  1494.            (looking-at "^# *\\(include\\|line\\)"))
  1495.          ;; Disregard lines being #include or #line directives.
  1496.          (end-of-line))
  1497.  
  1498.         ;; Else, find the end of the string.
  1499.         (t (setq start (1- (point)))
  1500.            (while (not (= (following-char) ?\"))
  1501.          (skip-chars-forward "^\"\\\\")
  1502.          (if (= (following-char) ?\\) (forward-char 2)))
  1503.            (forward-char 1)
  1504.            (setq end (point))
  1505.  
  1506.            ;; Check before string for keyword and opening parenthesis.
  1507.            (goto-char start)
  1508.            (skip-chars-backward " \n\t")
  1509.            (if (= (preceding-char) ?\()
  1510.            (progn
  1511.              (backward-char 1)
  1512.              (skip-chars-backward " \n\t")
  1513.              (let ((end-keyword (point)))
  1514.                (skip-chars-backward "_A-Za-z0-9")
  1515.                (if (member (list (buffer-substring (point) end-keyword))
  1516.                    keywords)
  1517.  
  1518.                ;; Disregard already marked strings.
  1519.                (progn
  1520.                  (goto-char end)
  1521.                  (setq start nil)
  1522.                  (setq end nil)))))))))
  1523.  
  1524.     ;; Return the found string, if any.
  1525.     (cons start end)))
  1526.  
  1527. (defun po-mark-c-string (start end keyword)
  1528.   "Mark the C string, from START to END, with KEYWORD.
  1529. Return the adjusted value for END."
  1530.   (goto-char end)
  1531.   (insert ")")
  1532.   (goto-char start)
  1533.   (insert keyword)
  1534.   (if (not (string-equal keyword "_"))
  1535.       (progn (insert " ") (setq end (1+ end))))
  1536.   (insert "(")
  1537.   (+ end 2 (length keyword)))
  1538.  
  1539. ;;; Emacs LISP mode.
  1540.  
  1541. (defun po-find-emacs-lisp-string (keywords)
  1542.   "Find the next Emacs LISP string, excluding those marked by any of KEYWORDS.
  1543. Returns (START . END) for the found string, or (nil . nil) if none found."
  1544.   (let (start end)
  1545.     (while (and (not start)
  1546.         (re-search-forward "[;\"?]" nil t))
  1547.  
  1548.       (cond ((= (preceding-char) ?\;)
  1549.          ;; Disregard comments.
  1550.          (search-forward "\n"))
  1551.  
  1552.         ((= (preceding-char) ?\?)
  1553.          ;; Disregard character constants.
  1554.          (forward-char (if (= (following-char) ?\\) 2 1)))
  1555.  
  1556.         ;; Else, find the end of the string.
  1557.         (t (setq start (1- (point)))
  1558.            (while (not (= (following-char) ?\"))
  1559.          (skip-chars-forward "^\"\\\\")
  1560.          (if (= (following-char) ?\\) (forward-char 2)))
  1561.            (forward-char 1)
  1562.            (setq end (point))
  1563.  
  1564.            ;; Check before string for keyword and opening parenthesis.
  1565.            (goto-char start)
  1566.            (skip-chars-backward " \n\t")
  1567.            (let ((end-keyword (point)))
  1568.          (skip-chars-backward "-_A-Za-z0-9")
  1569.          (if (and (= (preceding-char) ?\()
  1570.               (member (list (buffer-substring (point) end-keyword))
  1571.                   keywords))
  1572.  
  1573.              ;; Disregard already marked strings.
  1574.              (progn
  1575.                (goto-char end)
  1576.                (setq start nil)
  1577.                (setq end nil)))))))
  1578.  
  1579.     ;; Return the found string, if any.
  1580.     (cons start end)))
  1581.  
  1582. (defun po-mark-emacs-lisp-string (start end keyword)
  1583.   "Mark the Emacs LISP string, from START to END, with KEYWORD.
  1584. Return the adjusted value for END."
  1585.   (goto-char end)
  1586.   (insert ")")
  1587.   (goto-char start)
  1588.   (insert "(" keyword)
  1589.   (if (not (string-equal keyword "_"))
  1590.       (progn (insert " ") (setq end (1+ end))))
  1591.   (+ end 2 (length keyword)))
  1592.  
  1593. ;;; Processing generic to all programming modes.
  1594.  
  1595. (eval-and-compile
  1596.   (autoload 'visit-tags-table-buffer "etags"))
  1597.  
  1598. (defun po-tags-search (restart)
  1599.   (interactive "P")
  1600.   "Find an unmarked translatable string through all files in tags table.
  1601. Disregard some simple strings which are most probably non-translatable.
  1602. With prefix argument, restart search at first file."
  1603.  
  1604.   ;; Take care of restarting the search if necessary.
  1605.   (if restart (setq po-next-file-list nil))
  1606.  
  1607.   ;; Loop doing things until an interesting string is found.
  1608.   (let ((keywords po-keywords)
  1609.     find-string found buffer start
  1610.     (end po-string-end))
  1611.     (while (not found)
  1612.  
  1613.       ;; Reinitialize the source file list if necessary.
  1614.       (if (not po-next-file-list)
  1615.       (progn
  1616.         (setq po-next-file-list
  1617.           (save-excursion
  1618.             (visit-tags-table-buffer)
  1619.             (copy-sequence (tags-table-files))))
  1620.         (or po-next-file-list (error (_"No files to process")))
  1621.         (setq end nil)))
  1622.  
  1623.       ;; Try finding a string after resuming the search position.
  1624.       (message (_"Scanning %s...") (car po-next-file-list))
  1625.       (save-excursion
  1626.     (setq buffer (find-file-noselect (car po-next-file-list)))
  1627.     (set-buffer buffer)
  1628.     (goto-char (or end (point-min)))
  1629.  
  1630.     (cond ((string= mode-name "C")
  1631.            (let ((pair (po-find-c-string keywords)))
  1632.          (setq start (car pair))
  1633.          (setq end (cdr pair))))
  1634.           ((string= mode-name "Emacs-Lisp")
  1635.            (let ((pair (po-find-emacs-lisp-string keywords)))
  1636.          (setq start (car pair))
  1637.          (setq end (cdr pair))))
  1638.           (t (message (_"Unknown source mode for PO mode, skipping..."))
  1639.          (setq start nil)
  1640.          (setq end nil))))
  1641.  
  1642.       ;; Advance to next file if no string was found.
  1643.       (if (not start)
  1644.       (progn
  1645.         (setq po-next-file-list (cdr po-next-file-list))
  1646.         (if (not po-next-file-list) (error (_"All files processed")))
  1647.         (setq end nil))
  1648.  
  1649.     ;; Push the string just found string into the work buffer for study.
  1650.     (po-extract-unquoted buffer start end)
  1651.     (save-excursion
  1652.       (set-buffer po-work-buffer)
  1653.       (goto-char (point-min))
  1654.  
  1655.       ;; Do not disregard if at least three letters in a row.
  1656.       (if (re-search-forward "[A-Za-z][A-Za-z][A-Za-z]" nil t)
  1657.           (setq found t)
  1658.  
  1659.         ;; Disregard if two letters, and more punctuations than letters.
  1660.         (if (re-search-forward "[A-Za-z][A-Za-z]" nil t)
  1661.         (let ((total (buffer-size)))
  1662.           (goto-char (point-min))
  1663.           (while (re-search-forward "[A-Za-z]+" nil t)
  1664.             (replace-match "" t t))
  1665.           (if (< (* 2 (buffer-size)) total)
  1666.               (setq found t))))
  1667.  
  1668.         ;; Disregard if single letters or no letters at all.
  1669.         ))))
  1670.  
  1671.     ;; Ensure the string is being displayed.
  1672.  
  1673.     (if (one-window-p t) (split-window) (other-window 1))
  1674.     (switch-to-buffer buffer)
  1675.     (goto-char start)
  1676.     (recenter 1)
  1677.     (if (pos-visible-in-window-p end)
  1678.     (goto-char end)
  1679.       (goto-char end)
  1680.       (recenter -1))
  1681.     (other-window 1)
  1682.  
  1683.     ;; Save the string for later commands.
  1684.     (message (_"Scanning %s...done") (car po-next-file-list))
  1685.     (setq po-string-start start)
  1686.     (setq po-string-end end)))
  1687.  
  1688. (defun po-mark-found-string (keyword)
  1689.   "Mark last found string in program sources as translatable, using KEYWORD."
  1690.   (let ((buffer (find-file-noselect (car po-next-file-list)))
  1691.     (start po-string-start)
  1692.     (end po-string-end)
  1693.     line string)
  1694.  
  1695.     ;; Mark string in program sources.
  1696.     (setq string (po-extract-unquoted buffer start end))
  1697.     (save-excursion
  1698.       (set-buffer buffer)
  1699.       (setq line (count-lines (point-min) start))
  1700.       (setq end (cond ((string= mode-name "C")
  1701.                (po-mark-c-string start end keyword))
  1702.               ((string= mode-name "Emacs-Lisp")
  1703.                (po-mark-emacs-lisp-string start end keyword))
  1704.               (t (error (_"Cannot mark in unknown source mode"))))))
  1705.     (setq po-string-end end)
  1706.  
  1707.     ;; Add PO file entry.
  1708.     (let ((buffer-read-only nil))
  1709.       (goto-char (point-max))
  1710.       (insert "\n"
  1711.           (format "#: %s:%d\n" (car po-next-file-list) line)
  1712.           (po-eval-requoted string "msgid" nil)
  1713.           "msgstr \"\"\n")
  1714.       (previous-line 1)
  1715.       (setq po-untranslated-counter (1+ po-untranslated-counter))
  1716.       (po-update-mode-line-string))))
  1717.  
  1718. (defun po-mark-translatable ()
  1719.   (interactive)
  1720.   "Mark last found string in program sources as translatable, using `_'."
  1721.   (if (and po-string-start po-string-end)
  1722.       (progn
  1723.     (po-mark-found-string "_")
  1724.     (setq po-string-start nil))
  1725.     (error (_"No such string"))))
  1726.  
  1727. (defun po-select-mark-and-mark (arg)
  1728.   (interactive "P")
  1729.   "Mark last found string in program sources as translatable, ask for keywoard,
  1730. using completion.  With prefix argument, just ask the name of a preferred
  1731. keyword for subsequent commands, also added to possible completions."
  1732.   (if arg
  1733.       (let ((keyword (list (read-from-minibuffer (_"Keyword: ")))))
  1734.     (setq po-keywords (cons keyword (delete keyword po-keywords))))
  1735.     (if (and po-string-start po-string-end)
  1736.     (let* ((default (car (car po-keywords)))
  1737.            (keyword (completing-read (format (_"Mark with keywoard? [%s] ")
  1738.                          default)
  1739.                      po-keywords nil t )))
  1740.       (if (string-equal keyword "") (setq keyword default))
  1741.       (po-mark-found-string keyword)
  1742.       (setq po-string-start nil))
  1743.       (error (_"No such string")))))
  1744.  
  1745. ;;; Miscellaneous features.
  1746.  
  1747. (defun po-help ()
  1748.   "Provide an help window for PO mode."
  1749.   (interactive)
  1750.   (po-check-lock)
  1751.   (save-window-excursion
  1752.     (switch-to-buffer po-work-buffer)
  1753.     (erase-buffer)
  1754.     (insert po-help-display-string)
  1755.     (delete-other-windows)
  1756.     (goto-char (point-min))
  1757.     (message (_"Type any character to continue"))
  1758.     (read-char))
  1759.   (bury-buffer po-work-buffer))
  1760.  
  1761. (defun po-undo ()
  1762.   "Undo the last change to the PO file."
  1763.   (interactive)
  1764.   (let ((buffer-read-only nil))
  1765.     (undo))
  1766.   (po-compute-counters nil))
  1767.  
  1768. (defun po-statistics ()
  1769.   "Say how many entries in each category, and the current position."
  1770.   (interactive)
  1771.   (po-compute-counters t))
  1772.  
  1773. (defun po-validate ()
  1774.   "Use `msgfmt' for validating the current PO file contents."
  1775.   (interactive)
  1776.  
  1777.   ;; If modifications were done already, change the last revision date.
  1778.   (if (buffer-modified-p)
  1779.       (po-replace-revision-date))
  1780.  
  1781.   ;; This `let' is for protecting the previous value of compile-command.
  1782.   (let ((compile-command (concat po-msgfmt-program
  1783.                  " --statistics -c -v -o /dev/null "
  1784.                  buffer-file-name)))
  1785.     (compile compile-command)))
  1786.  
  1787. (defun po-confirm-and-quit ()
  1788.   "Confirm if quit should be attempted and then, do it.
  1789. This is a failsafe.  Confirmation is asked if only the real quit would not."
  1790.   (interactive)
  1791.   (if (or (buffer-modified-p)
  1792.       (> po-untranslated-counter 0)
  1793.       (> po-fuzzy-counter 0)
  1794.       (> po-obsolete-counter 0)
  1795.       (y-or-n-p (_"Really quit editing this PO file? ")))
  1796.       (po-quit))
  1797.   (message ""))
  1798.  
  1799. (defun po-quit ()
  1800.   "Save the PO file and kill buffer.  However, offer validation if
  1801. appropriate and ask confirmation if untranslated strings remain."
  1802.   (interactive)
  1803.   (let ((quit t))
  1804.  
  1805.     ;; Offer validation of newly modified entries.
  1806.     (if (and (buffer-modified-p)
  1807.          (not (y-or-n-p (_"File was modified; skip validation step? "))))
  1808.     (progn
  1809.       (message "")
  1810.       (setq quit nil)
  1811.       (po-validate)))
  1812.  
  1813.     ;; Offer to work on untranslated entries.
  1814.     (if (and quit
  1815.          (or (> po-untranslated-counter 0)
  1816.          (> po-fuzzy-counter 0)
  1817.          (> po-obsolete-counter 0))
  1818.          (not (y-or-n-p (_"Unprocessed entries remain; quit anyway? "))))
  1819.     (progn
  1820.       (setq quit nil)
  1821.       (po-auto-select-entry)))
  1822.  
  1823.     ;; Clear message area.
  1824.     (message "")
  1825.  
  1826.     ;; Or else, kill buffers and quit for true.
  1827.     (if quit
  1828.     (progn
  1829.       (if (buffer-modified-p)
  1830.           (po-replace-revision-date))
  1831.       (save-buffer)
  1832.       ;; kill-buffer-hook is used if it exists: avoid overkilling! :-)
  1833.       (or (boundp 'kill-buffer-hook) (kill-buffer po-work-buffer))
  1834.       (kill-buffer (current-buffer))))))
  1835.  
  1836. ;;; po-mode.el ends here
  1837.