my-wrap-latin-runs.el

;;; -*- lexical-binding: t -*-

;; Enclose \lr intelligently
(defun my-blank-p (char)
  (string-match-p "^[[:blank:]\n]$" (char-to-string char)))

(defun my-char-type (char)
  (let ((bidi-class (get-char-code-property char 'bidi-class)))
    (cond
     ((seq-contains-p "۰۱۲۳۴۵۶۷۸۹" char) 'Persian)
     ((member bidi-class '(L EN)) 'Latin)
     ((member bidi-class '(R AL)) 'Persian)
     ((my-blank-p char) 'Space)
     (t 'Neutral))))

(defun my-wrap-latin-runs (start end)
  "Wrap Latin runs of text in \\lr{}"
  (interactive "r")
  (save-excursion
    (let ((end-m (copy-marker end t))
          (from nil)
          (to nil)
          (type nil)
          (prv-picked nil))
      (goto-char start)
      (while (< (point) end-m)
        (setq type (my-char-type (char-after)))
        (cond
         ((eq type 'Neutral)
          (setq from (point)))
         ((eq type 'Latin)
          (if (not from)
              (setq from (point)))
          (setq prv t)
          (while (and (< (point) end-m)
                      (not (eq (my-char-type (char-after)) 'Persian)))
            (setq type (my-char-type (char-after)))
            (if (or (eq type 'Latin)
                    (and prv-picked (eq type 'Neutral)))
                (progn
                  (setq to (point))
                  (setq prv-picked t))
              (setq prv-picked nil))
            (forward-char))
          (let ((to-m (copy-marker (point) t)))
            (goto-char to)
            (forward-char)
            (insert "}")
            (goto-char from)
            (insert "\\lr{")
            (goto-char to-m))
          (setq from nil))
         (t
          (setq from nil)))
        (forward-char)))))

(with-eval-after-load 'tex-mode
  (define-key tex-mode-map (kbd "C-c r") 'my-wrap-latin-runs))