搜寻Bash中可翻译字符串的elisp程序

这是一段搜寻并标记Shell脚本中可被翻译的字符串的elisp程序（emacs用的脚本程序）。在emacs中打开一个Shell脚本，然后按F7，这个程序会从光标所在位置开始搜寻脚本中可被翻译的字符串，找到后询问是否要将此字符串标记为可翻译。如果得到肯定回答，则将此字符串放入$(eval_gettext "")中，然后继续搜寻下一个可翻译的字符串。

如果用户选择错误，或者emacs没有能正确的找到字符串（emacs的语法分析有时候还是会出错的，特别是在语法特别复杂的shell上），可以按Esc或者ctrl-g停止。然后可以undo上一次标记的动作，或者用鼠标手动选出需要翻译的字符串，然后按F6自动加上eval_gettext标记。还可以用F5键，它会自动将光标后的第一个字符串标记为可翻译。

;;; find a string
(defun translatable-search ()
  (let ((start nil)
        (end nil))
    (while (and (not (eq ?\" (nth 3 (syntax-ppss))))
                (search-forward "\"" nil t)))
    (when (setq start (nth 8 (syntax-ppss)))
      (while (and (search-forward "\"" nil t)
                  (eq ?\" (nth 3 (syntax-ppss)))))
      (when (not (eq ?\" (nth 3 (syntax-ppss))))
        (list (+ start 1) (- (point) 1))))))

;;; find a string which is embedded in another string
(defun translatable-search-embedded (limit)
  (let ((start nil)
        (end nil))
    (when (re-search-forward 
           (concat "\\\\\"\\([^\000]*?\\)\\\\\"" "\\|"
                   "[^\\\\]\"\\(\\|[^\000]*?[^\\\\]\\)\"" "\\|"
                   "<label>\\([^\000]*?\\)</label>" "\\|"
                   "<wtitle>\\([^\000]*?\\)</wtitle>" "\\|"
                   "<frame \\([^\000]*?\\)>")
           limit t)
      (dolist (elt '(1 2 3 4 5) (list start end))
        (setq start (or start (match-beginning elt)))
        (setq end (or end (match-end elt)))))))

;;; analyze whether a string needs to be translated
(defun translatable-analyze (start end)
  (let ((score 0)
        (str nil))
    (save-excursion
      (setq str (buffer-substring start end))
      (goto-char start)

      (when (or (looking-back "<label>")
                (looking-back "<wtitle>")
                (looking-back "<window[[:blank:]]+title=\\\\\"")
                (looking-back "<frame ")
                (looking-back "[[:blank:]]+-?-title[[:blank:]]+[\\\\]?\""))
        (setq score (+ score 100)))
      (when (or (looking-back "[[:alnum:]]*MSG[[:alnum:]]*=\""))
        (setq score (+ score 50)))

      (when (or (string-match "\\`[[:blank:]]*`" str)
                (string-match "\\`[[:blank:]]*\\$(" str)
                (string-match "\\`[[:blank:]]*\\'" str)
                (string-match "\\`\\\\\"[[:blank:]]*\\\\\"\\'" str)
                (string-match "\\`\\$[[:alnum:]_]+\\'" str)
                (string-match "\\`\\${[[:alnum:]_]+}\\'" str)
                (string-match "\\`[^[:alpha:]]+\\'" str)
                )
        (setq score (- score 150)))
      (when (or (looking-back (concat "[^[:alnum:]]\\(?:" 
                                      "icon-name" "\\|"
                                      "type" "\\|"
                                      "icon" "\\|"
                                      "stock" "\\|"
                                      "use-markup"
                                      "\\)=\\\\\""))
                (looking-back (concat "[[:blank:]]+-?-\\(?:"
                                      "bg" "\\|"
                                      "font" "\\|"
                                      "name" "\\|"
                                      "wmclass"
                                      "\\)[[:blank:]]+[\\\\]?\""))
                (looking-back "[[:blank:]]*yaf-splash.*")
                (and (looking-back " = \"")
                     (save-excursion
                       (goto-char end)
                       (looking-at "\" \\]")))
                (looking-back " | grep \"")
                (string= "true" str)
                (string= "false" str)
                (string= "yes" str)
                (string= "no" str)
                (and (string-match "\\([^\000]*<\\)\\{10\\}" str)
                     (string-match "\\([^\000]*>\\)\\{10\\}" str))
                )
        (setq score (- score 50)))
      (>= score 0)
      )))

;;; mark a string translatable by putting it in a eval_gettext clause
(defun translatable-mark (start end)
  (interactive "r")
  (let ((limit (copy-marker end)))
    (save-excursion
      (undo-boundary)
      (setq buffer-undo-list (cons (point) buffer-undo-list))
      (goto-char start)
      (while (search-forward "$" limit t)
        (replace-match "\\\\$"))
      (goto-char limit)
      (insert "\")")
      (goto-char start)
      (insert "$(eval_gettext \""))
    (syntax-ppss-flush-cache (point-min))
    ))

;;; highlight a region
(defun translatable-highlight (start end)
  (goto-char start)
  (transient-mark-mode nil)
  (push-mark)
  (goto-char end)
  (transient-mark-mode t))

;;; search and mark translatable string
(defun translatable ()
  (interactive)
  (let ((ret nil)
        (start nil)
        (limit nil)
        (start2 nil)
        (limit2 nil))
    (while (setq ret (translatable-search))
      (save-excursion
        (setq start (car ret))
        (setq limit (copy-marker (cadr ret)))
        (translatable-highlight start limit)
        (if (and (translatable-analyze start limit)
                 (y-or-n-p "Mark this string translatable? "))
            (translatable-mark start limit)
          (progn 
            (goto-char start)
            (while (setq ret (translatable-search-embedded limit))
              (save-excursion
                (setq start2 (car ret))
                (setq limit2 (copy-marker (cadr ret)))
                (translatable-highlight start2 limit2)
                (when (and (translatable-analyze start2 limit2)
                           (y-or-n-p "Mark this string translatable? "))
                  (translatable-mark start2 limit2))
                ))))
        (kill-region start limit)
        (yank)
        ))))


(add-hook 
 'sh-mode-hook
 (lambda () 
   (local-set-key [f6] 'translatable-mark)
   (local-set-key [f7] 'translatable)
   (local-set-key [f5] 
                  (lambda ()
                    (interactive)
                    (let ((start nil)
                          (limit nil))
                      (setq ret (translatable-search-embedded (point-max)))
                      (save-excursion
                        (translatable-mark (car ret) (cadr ret))
                        ))))
   ))
   

(provide 'translatable)