]> git.eshelyaron.com Git - emacs.git/commitdiff
New commands to convert ASCII to fullwidth characters and back
authorEli Zaretskii <eliz@gnu.org>
Sun, 2 Mar 2025 13:25:53 +0000 (15:25 +0200)
committerEshel Yaron <me@eshelyaron.com>
Tue, 4 Mar 2025 21:02:34 +0000 (22:02 +0100)
* lisp/textmodes/text-mode.el (text-mode--fullwidth-table): New
variable.
(text-mode--get-fullwidth-table): New internal function.
(fullwidth-region, halfwidth-region, fullwidth-word)
(halfwidth-word): New commands.  (Bug#71822)

* etc/NEWS: Announce new commands.

(cherry picked from commit 8937dee9e418c64587769dd22bb9683cd3690688)

lisp/textmodes/text-mode.el

index d918efa72c6e75bac3a81d13e8ed8ce3a21e2189..2d019f54aec730afa5db4de349e06be4f21ae19a 100644 (file)
@@ -271,6 +271,85 @@ The argument NLINES says how many lines to center."
 
 (define-obsolete-function-alias 'indented-text-mode #'text-mode "29.1")
 
+\f
+
+(defvar text-mode--fullwidth-table nil)
+
+(defun text-mode--get-fullwidth-table ()
+  "Return translation table for converting half-width characters to fullwidth."
+  (or (and (char-table-p text-mode--fullwidth-table)
+           text-mode--fullwidth-table)
+      ;; Create the translation table.
+      (let ((tbl (make-char-table 'translation-table))
+            (rev-tbl (make-char-table 'translation-table))
+            (ch ?!))
+        (while (<= ch ?~)
+          ;; ! -> !, 0 -> 0, A -> A, etc.
+          (aset tbl ch (+ ch #xFEE0))
+          (aset rev-tbl (+ ch #xFEE0) ch)
+          (setq ch (1+ ch)))
+        (set-char-table-extra-slot tbl 0 rev-tbl)
+        (set-char-table-extra-slot tbl 1 1)
+        (set-char-table-extra-slot rev-tbl 1 1)
+        (put 'text-mode--fullwidth-table 'translation-table tbl)
+        (setq text-mode--fullwidth-table tbl)
+        tbl)))
+
+(defun fullwidth-region (from to)
+  "Convert ASCII characters in the region to their fullwidth variants.
+This converts 1 to 1, A to A, etc.
+When called from Lisp, FROM and TO are character positions that define
+the region in which to convert characters."
+  (interactive "r")
+  (translate-region from to
+                    (text-mode--get-fullwidth-table)))
+
+(defun halfwidth-region (from to)
+  "Convert fullwidth characters in the region to their ASCII variants.
+This converts 1 to 1, A to A, etc.
+When called from Lisp, FROM and TO are character positions that define
+the region in which to convert characters."
+  (interactive "r")
+  (translate-region from to
+                    (char-table-extra-slot (text-mode--get-fullwidth-table)
+                                           0)))
+
+(defun fullwidth-word (arg)
+  "Convert fullwidth characters in word at point, moving over the word.
+This converts fullwidth characters to their ASCII variants:
+1 to 1, A to A, etc.
+With numerical argument ARG, convert that many words starting from point.
+With negative argument, convert previous words, but do not move point.
+If point is in the middle of a word, the part of that word before point
+is ignored when converting forward, and the part of that word after
+point is ignored when converting backward."
+  (interactive "p")
+  (let* ((pt (point-marker))
+         (beg pt)
+         (end (progn
+                (forward-word arg)
+                (point))))
+    (fullwidth-region beg end)
+    (or (> arg 0) (goto-char pt))))
+
+(defun halfwidth-word (arg)
+  "Convert characters in word at point to fullwidth, moving over the word.
+This converts ASCII characters to their fullwidth variants:
+1 to 1, A to A, etc.
+With numerical argument ARG, convert that many words starting from point.
+With negative argument, convert previous words, but do not move point.
+If point is in the middle of a word, the part of that word before point
+is ignored when converting forward, and the part of that word after
+point is ignored when converting backward."
+  (interactive "p")
+  (let* ((pt (point-marker))
+         (beg pt)
+         (end (progn
+                (forward-word arg)
+                (point))))
+    (halfwidth-region beg end)
+    (or (> arg 0) (goto-char pt))))
+
 (provide 'text-mode)
 
 ;;; text-mode.el ends here