>From b6afe90c963be3a907d27554f7896333834e78a5 Mon Sep 17 00:00:00 2001 From: Eliza Velasquez <4576666+elizagamedev@users.noreply.github.com> Date: Thu, 13 Jul 2023 20:49:31 -0700 Subject: [PATCH 4/4] po-mode.el: Add major-mode based fontification --- gettext-tools/emacs/po-mode.el | 239 ++++++++++++++++++++++++++------- 1 file changed, 187 insertions(+), 52 deletions(-) diff --git a/gettext-tools/emacs/po-mode.el b/gettext-tools/emacs/po-mode.el index a5d28d193..2ab92c1be 100644 --- a/gettext-tools/emacs/po-mode.el +++ b/gettext-tools/emacs/po-mode.el @@ -62,6 +62,8 @@ ;;; Code: +(require 'diff) + (defconst po-mode-version-string "2.28" "\ Version number of this version of po-mode.el.") @@ -500,6 +502,23 @@ supercedes `po-subedit-mode-syntax-table'." :type 'symbol :local t :group 'po) + +(defcustom po-fontify-messages t + "Fontify messages based on `po-subedit-mode-major-mode'. +This will replace the display of messages, both msgid and msgstr, +with unescaped and fontified text based on +`po-subedit-mode-major-mode'. This option has no effect if +`po-subedit-mode-major-mode' is `text-mode'." + :type 'boolean + :group 'po) + +(defface po-fontified-msgid + '((t :inherit diff-removed :extend nil)) + "Face used for fontified msgids in `po-mode'.") + +(defface po-fontified-msgstr + '((t :inherit diff-added :extend nil)) + "Face used for fontified msgstrs in `po-mode'.") ;;; Emacs portability matters - part II. @@ -933,6 +952,7 @@ M-S Ignore path M-A Ignore PO file *M-L Ignore lexicon ("^\\(\\(msg\\(ctxt\\|id\\(_plural\\)?\\|str\\(\\[[0-9]\\]\\)?\\)\\) \\)?\"\\|\"$" . font-lock-keyword-face) ("\\\\.\\|%[*$-.0-9hjltuzL]*[a-zA-Z]" . font-lock-variable-name-face) + (po-fontify-messages) ) "Additional expressions to highlight in PO mode.") @@ -1046,6 +1066,9 @@ all reachable through 'M-x customize', in group 'Emacs.Editing.I18n.Po'." (if (fboundp 'easy-menu-define) (easy-menu-define po-mode-menu po-mode-map "" po-mode-menu-layout)) (set (make-local-variable 'font-lock-defaults) '(po-font-lock-keywords t)) + (add-hook 'font-lock-extend-region-functions + #'po-font-lock-extend-region-past-multiline + 100 t) (set (make-local-variable 'po-read-only) buffer-read-only) (setq buffer-read-only t) @@ -1737,32 +1760,36 @@ Crumb preceding or following the quoted string is ignored." Surrounding quotes are already excluded by the position of START and END." (po-with-temp-buffer (insert-buffer-substring buffer start end) - ;; Glue concatenated strings. - (goto-char (point-min)) - (while (re-search-forward "\"[ \t]*\\\\?\n\\(#~\\)?[ \t]*\"" nil t) - (replace-match "" t t)) - ;; Remove escaped newlines. - (goto-char (point-min)) - (while (re-search-forward "\\\\[ \t]*\n" nil t) - (replace-match "" t t)) - ;; Unquote individual characters. - (goto-char (point-min)) - (while (re-search-forward "\\\\[\"abfnt\\0-7]" nil t) - (cond ((eq (preceding-char) ?\") (replace-match "\"" t t)) - ((eq (preceding-char) ?a) (replace-match "\a" t t)) - ((eq (preceding-char) ?b) (replace-match "\b" t t)) - ((eq (preceding-char) ?f) (replace-match "\f" t t)) - ((eq (preceding-char) ?n) (replace-match "\n" t t)) - ((eq (preceding-char) ?t) (replace-match "\t" t t)) - ((eq (preceding-char) ?\\) (replace-match "\\" t t)) - (t (let ((value (- (preceding-char) ?0))) - (replace-match "" t t) - (while (looking-at "[0-7]") - (setq value (+ (* 8 value) (- (following-char) ?0))) - (replace-match "" t t)) - (insert value))))) + (po--unquote-inline) (buffer-string))) +(defun po--unquote-inline () + "Unquote the message in the current buffer." + ;; Glue concatenated strings. + (goto-char (point-min)) + (while (re-search-forward "\"[ \t]*\\\\?\n\\(#~\\)?[ \t]*\"" nil t) + (replace-match "" t t)) + ;; Remove escaped newlines. + (goto-char (point-min)) + (while (re-search-forward "\\\\[ \t]*\n" nil t) + (replace-match "" t t)) + ;; Unquote individual characters. + (goto-char (point-min)) + (while (re-search-forward "\\\\[\"abfnt\\0-7]" nil t) + (cond ((eq (preceding-char) ?\") (replace-match "\"" t t)) + ((eq (preceding-char) ?a) (replace-match "\a" t t)) + ((eq (preceding-char) ?b) (replace-match "\b" t t)) + ((eq (preceding-char) ?f) (replace-match "\f" t t)) + ((eq (preceding-char) ?n) (replace-match "\n" t t)) + ((eq (preceding-char) ?t) (replace-match "\t" t t)) + ((eq (preceding-char) ?\\) (replace-match "\\" t t)) + (t (let ((value (- (preceding-char) ?0))) + (replace-match "" t t) + (while (looking-at "[0-7]") + (setq value (+ (* 8 value) (- (following-char) ?0))) + (replace-match "" t t)) + (insert value)))))) + (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 @@ -1774,35 +1801,43 @@ If FORM is itself a string, then this string is used for insertion." (insert form) (push-mark) (eval form)) + (po--requote-inline prefix obsolete) + (buffer-string))) + +(defun po--requote-inline (prefix obsolete) + "Requote the message in the current buffer. +See `po-eval-requoted' for PREFIX and OBSOLETE." + (goto-char (point-min)) + (let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t))) (goto-char (point-min)) - (let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t))) - (goto-char (point-min)) - (while (re-search-forward "[\"\a\b\f\n\r\t\\]" nil t) - (cond ((eq (preceding-char) ?\") (replace-match "\\\"" t t)) - ((eq (preceding-char) ?\a) (replace-match "\\a" t t)) - ((eq (preceding-char) ?\b) (replace-match "\\b" t t)) - ((eq (preceding-char) ?\f) (replace-match "\\f" t t)) - ((eq (preceding-char) ?\n) - (replace-match (if (or (not multi-line) (eobp)) - "\\n" - "\\n\"\n\"") - t t)) - ((eq (preceding-char) ?\r) (replace-match "\\r" t t)) - ((eq (preceding-char) ?\t) (replace-match "\\t" t t)) - ((eq (preceding-char) ?\\) (replace-match "\\\\" t t)))) - (goto-char (point-min)) - (if prefix (insert prefix " ")) - (insert (if multi-line "\"\"\n\"" "\"")) - (goto-char (point-max)) - (insert "\"") - (if prefix (insert "\n")) - (if obsolete - (progn - (goto-char (point-min)) - (while (not (eobp)) - (or (eq (following-char) ?\n) (insert "#~ ")) - (search-forward "\n")))) - (buffer-string)))) + (while (re-search-forward "[\"\a\b\f\n\r\t\\]" nil t) + (let ((properties (text-properties-at (match-beginning 0))) + (replacement + (cond ((eq (preceding-char) ?\") "\\\"") + ((eq (preceding-char) ?\a) "\\a") + ((eq (preceding-char) ?\b) "\\b") + ((eq (preceding-char) ?\f) "\\f") + ((eq (preceding-char) ?\n) + (if (or (not multi-line) (eobp)) + "\\n" + "\\n\"\n\"")) + ((eq (preceding-char) ?\r) "\\r") + ((eq (preceding-char) ?\t) "\\t") + ((eq (preceding-char) ?\\) "\\\\")))) + (when replacement + (replace-match (apply #'propertize replacement properties) t t)))) + (goto-char (point-min)) + (if prefix (insert prefix " ")) + (insert (if multi-line "\"\"\n\"" "\"")) + (goto-char (point-max)) + (insert "\"") + (if prefix (insert "\n")) + (if obsolete + (progn + (goto-char (point-min)) + (while (not (eobp)) + (or (eq (following-char) ?\n) (insert "#~ ")) + (search-forward "\n")))))) (defun po-get-msgid () "Extract and return the unquoted msgid string." @@ -2794,6 +2829,106 @@ keyword for subsequent commands, also added to possible completions." (if (string-equal keyword "") (setq keyword default)) (po-mark-found-string keyword)))) +;;; Inline fontification based on major mode. + +(defun po-font-lock-extend-region-past-multiline () + "Extend font lock region past multiline strings." + (eval-when-compile (defvar font-lock-beg) (defvar font-lock-end)) + (when po-fontify-messages + (save-excursion + (let ((beg (progn + (goto-char font-lock-beg) + (beginning-of-line) + (while (looking-at-p "^\".*\"$") + (forward-line -1)) + (point))) + (end (progn + (goto-char font-lock-end) + (beginning-of-line) + (while (looking-at-p "^\".*\"$") + (forward-line 1)) + (max font-lock-end (point))))) + (if (and (eq font-lock-beg beg) + (eq font-lock-end end)) + nil + (setq font-lock-beg beg + font-lock-end end) + t))))) + +(defun po-fontify-messages (limit) + "Try to apply `po-fontify-messages-1'. +See `po-fontify-messages-1' for details about LIMIT." + (condition-case nil + (po-fontify-messages-1 limit) + (error (message "PO mode fontification error in %S at %d" + (current-buffer) + (line-number-at-pos))))) + +(defun po-fontify-messages-1 (limit) + "Fontify msgid and msgstr as unescaped messages. +Operates from `point' up to LIMIT." + (when (and po-fontify-messages + (fboundp po-subedit-mode-major-mode) + (not (eq po-subedit-mode-major-mode #'text-mode))) + (while (re-search-forward po-any-msgstr-block-regexp limit t) + (save-excursion + (goto-char (match-beginning 0)) + (po-find-span-of-entry) + (unless po-start-of-msgid_plural + (po-fontify-message po-start-of-msgid po-start-of-msgstr-form + 'po-fontified-msgid)) + (po-fontify-message po-start-of-msgstr-form po-end-of-msgstr-form + 'po-fontified-msgstr)))) + nil) + +(defun po-fontify-message (start end face) + "Propertize message between START and END. +Append FACE to its faces." + ;; Adjust bounds to be properly between the quotes. + (save-excursion + (goto-char start) + (search-forward "\"") + (setq start (point)) + (goto-char end) + (search-backward "\"") + (setq end (point))) + (let ((po-buffer (current-buffer)) + (modified (buffer-modified-p)) + (subedit-major-mode po-subedit-mode-major-mode) + (all-properties (append '(font-lock-face face) + font-lock-extra-managed-props)) + (inhibit-read-only t)) + (with-current-buffer + (get-buffer-create + (format " *po-fontification:%s*" subedit-major-mode)) + ;; Unqoute, fontify, requote. + (let ((inhibit-modification-hooks nil)) + (erase-buffer) + (insert-buffer-substring po-buffer start end) + (po--unquote-inline) + (funcall subedit-major-mode) + (font-lock-ensure) + (major-mode-suspend) + (po--requote-inline nil nil)) + ;; Copy text properties from this buffer back to po, assuming that the + ;; text length equals the unquoted text. Skip the first character, which + ;; is the initial quote. + (when (eq (- end start) (- (buffer-size) 2)) ; -2 to remove quotes. + (let ((pos (1+ (point-min))) next) + (while (setq next (next-property-change pos)) + (dolist (prop all-properties) + (let ((new-prop (get-text-property pos prop))) + (when new-prop + (put-text-property + (+ start pos -2) (+ start next -2) prop new-prop + po-buffer)))) + (setq pos next))))) + (font-lock-append-text-property start end 'face face) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified))) + ;;; Unknown mode specifics. (defun po-preset-string-functions () -- 2.40.1