Не бойтесь совершенства. Вам его не достичь!
                                           Сальвадор Дали


Взгляв в прошлое


В предыдущей статье, речь шла о том, как можно заставить курсор Emacs сохранять позицию в строке (столбец), при переходе к более короткой строке (грубо говоря — избавиться от «прыжков» курсора). Предложенное решение пожалуй обладало единственным достоинством — предельной простотой кода. Напомню, что для позиционирования курсора просто использовались дополнительные (лишние) пробелы.

Более основательное знакомство с Emacs Lisp и общение с откликнувшимися сведущими людьми (respect2: Иван Алексеев aka Yurii Sapfot) укрепило в мысли, что более правильное решение следует искать в направлении оверлеев. Так появилась версия №2 которую я и предлагаю уважаемым читателям.



Попытка №2


Собственно опять таки решение очевидно (при наличии определённого багажа знаний): использовать свойство before-string оверлея нулевой длины для позиционирования курсора в нужную позицию (разумеется при установленном моноширинном шрифте).

Общая структура решения осталась прежней: реализуется minor mode (wpers-mode) в рамках которого "ремапятся" базовые команды управления курсором (next-line, previous-line, left-char, right-char, backward-delete-char-untabify, move-end-of-line, move-beginning-of-line, scroll-up и scroll-down).

В первом варианте приходилось добавлять лишние пробелы, сейчас вместо этого мы будем просто создавать в текущей позиции оверлей нулевого размера и устанавливать его свойство before-string (далее по тексту для простоты изложения будем подразумевать именно это свойство говоря об оверлее в целом) в строку, состоящую из необходимого количества пробелов (или иных символов — см. листинг).

Далее, при перемешении курсора в пределах досягаемости оверлея (влево-вправо) мы будем просто корректировать значение этого свойства, увеличивая или уменьшая строку пробелов вплоть до пустой строки — в этом случае оверлей просто удаляется. Если же курсор выходит за пределы «зоны влияния» оверлея (вверх-вниз), то мы просто его удаляем и, при необходимости (переход вверх-вниз на более короткую строку), создаём новый. Наконец, при вводе какого-либо символа (включая тот же пробел) после ряда «оверлейных пробелов» мы удаляем оверлей, «легализовав» при этом все накопленные пробелы в реальные пробелы внутри буфера.

Полный код второй версии пакета можно получить с GitHub, здесь я вкратце пройдусь по ключевым фрагментам, не акцентирую внимания на мелочах (есть doc-string да и код достаточно компактен и прозрачен).

Итак, начнём с набора утилит, для работы с оверлеем:

;; Разукрашиваем оверлей при активном режиме выделения текущей строки
(defun wpers--ovr-propz-txt (txt) 
  (if (or hl-line-mode global-hl-line-mode)
      (propertize txt 'face (list :background (face-attribute 'highlight :background)))
      txt))

;; Создаём оверлей 0-й длины в текущей позиции, не забыв уничтожить прежний (если таковой имелся) 
(defun wpers--ovr-make (&optional str) 
  (wpers--ovr-kill)
  (setq wpers--overlay (make-overlay (point) (point)))
  (overlay-put wpers--overlay 'wpers t)
  (if str (overlay-put wpers--overlay 'before-string (wpers--ovr-propz-txt str))))

;; Проверка наличия оверлея в текущей позиции буфера
(defun wpers--ovr-at-point-p ()  
   (eq (point) (overlay-start wpers--overlay)))

;; Проверка наличия текста в строке после позиции оверлея
(defun wpers--ovr-txt-after-p () 
  (when wpers--overlay
    (let ((ch (char-after (overlay-start wpers--overlay))))
      (and ch (not (eq ch 10))))))

;; "Легализация" оверлейных пробелов в буферные
(defun wpers--ovr-to-spcs () 
  (let ((ovr-size (when (wpers--ovr-at-point-p) (length (wpers--ovr-get)))))
    (save-excursion
     (goto-char ov-pos)
     (insert (make-string (length (wpers--ovr-get)) 32)))
    (when ovr-size (right-char ovr-size))))

;; Уничтожение оверлея с "легализацией" пробелов при необходимости
(defun wpers--ovr-kill ()
  (when wpers--overlay
    (let* ((ov-pos (overlay-start wpers--overlay))
           (ch (char-after ov-pos)))
      (when (and ch (not (eq ch 10))) (wpers--ovr-to-spcs)))
    (delete-overlay wpers--overlay)
    (setq wpers--overlay nil)))

;; Уничтожаем оверлеи во всех буферах кроме текущего
(defun wpers--clean-up-ovrs ()
  (mapc #'(lambda (b)
              (when (and (local-variable-p 'wpers-mode b)
                         (buffer-local-value 'wpers-mode b)
                         (buffer-local-value 'wpers--overlay b)
                         (not (eq b (current-buffer))))
                (wpers--ovr-kill b)))
        (buffer-list)))

;; Чтение свойства before-string 
(defun wpers--ovr-get () 
   (overlay-get wpers--overlay 'before-string))

;; Установка свойства before-string с "раскраской текста" и возможностью выполнения 
;; каких-либо операций над текущим значением этого свойства, связываемым с переменной "_"
(defmacro wpers--ovr-put (val) 
  `(let ((_ (wpers--ovr-get)))
    (overlay-put wpers--overlay 'before-string (wpers--ovr-propz-txt ,val))))


Теперь заёмёмся позиционированием курсора в строке:

;; Текущая позиция курсора в строке (столбец) с учётом возможного наличия оверлея
(defun wpers--current-column () 
  (let ((res (current-column)))
    (if (and wpers--overlay (wpers--ovr-at-point-p))
        (+ res (length (wpers--ovr-get)))
        res)))

;; Позиционирование курсора в нужную позицию внутри строки (на экране - не в буфере!) с использованием оверлея
(defun wpers--move-to-column (col) 
  (move-to-column col)
  (let* ((last-column (- (line-end-position) (line-beginning-position)))
         (spcs-needed (- col last-column)))
    (when (plusp spcs-needed)
      (wpers--ovr-make (make-string spcs-needed wpers--pspace)))))

;; Выполнение произвольного выражения с сохранением позиции курсора в строке (столбца)
(defmacro wpers--save-vpos (form) 
  (let ((old-col (make-symbol "old-col")))
    `(let ((,old-col (wpers--current-column))) ,form (wpers--move-to-column ,old-col))))


Далее, определим набор функций для организации перехвата команд, влияющих на позицию курсора:

;; Базовая функция создания "обёрток" для команд управления курсором
(defun wpers--remap (key body &optional params)
  (let ((old (wpers--key-handler key)) ;; запомнили текущий обработчик
        (fun `(lambda ,params ;; новый обработчик
                "WPERS handler: perform operation with saving current cursor's position in the line (column)."
                ,@body)))
    (when old (add-to-list 'wpers--funs-alist (cons old fun))) ;; зафиксировали связь старый-новый обработчик
    (define-key wpers--mode-map key fun))) ;; установили новый обработчик в keymap режима

;; "Обёртка" для команд перемещающих курсор по вертикали
(defun wpers--remap-vert (command &optional key)
  (wpers--remap (wpers--mk-key command key) 
                `((interactive)(wpers--save-vpos (call-interactively ',command)))))

;; "Обёртка" для "идёт налево"
(defun wpers--remap-left (command &optional key)
  (let ((key (wpers--mk-key command key))
        (expr `(call-interactively ',command)))
    (wpers--remap key
       `((interactive)
         (if wpers--overlay
             (if (and (wpers--ovr-at-point-p) (wpers--at-end (point)))
                 (if (plusp (length (wpers--ovr-get)))
                     (wpers--ovr-put (substring _ 1))
                     (wpers--ovr-kill) ,expr)
                 (wpers--ovr-kill) ,expr)
             ,expr)))))

;; "Обёртка" для "идёт направо"
(defun wpers--remap-right (command &optional key)
  (let ((key (wpers--mk-key command key))
        (expr `(call-interactively ',command)))
    (wpers--remap key
       `((interactive)
         (if (wpers--at-end (point))
             (if (null wpers--overlay)
                 (wpers--ovr-make (string wpers-pspace))
                 (if (wpers--ovr-at-point-p)
                     (wpers--ovr-put (concat _ (string wpers-pspace)))
                     (wpers--ovr-kill) (wpers--ovr-make (string wpers-pspace))))
             (wpers--ovr-kill) ,expr)))))

;; Позаботимся о "братьях меньших"
(defun wpers--remap-mouse (command)
  (wpers--remap (vector 'remap command) `(
    (interactive "e")
    (funcall ',command event)
    (let ((col (car (posn-col-row (cadr event)))))
      (wpers--move-to-column col))) '(event)))


Теперь определим ключевые «перехватчики» вызываемые до и после каждой команды:
;; Выключаем режим при активной (активации) отметке, visual-line-mode или "размазанных" строках (truncate-lines равна nil)
;; NB: read-only теперь не помеха работе режима
(defun wpers--pre-command-hook ()
  (if (member this-command wpers-ovr-killing-funs)
      (wpers--ovr-kill)
      (if (or this-command-keys-shift-translated mark-active visual-line-mode (null truncate-lines))
          (let ((fn-pair (rassoc this-command wpers--funs-alist)))
            (when fn-pair (setq this-command (car fn-pair)))))))

;; Удаляем оверлей если верно одно из условий:
;;  - курсор не находится в позиции оверлея
;;  - имеется текст в буфере после позиции оверлея, но до конца строки
(defun wpers--post-command-hook ()
  (when (and wpers--overlay
             (or (not (wpers--ovr-at-point-p))
                 (wpers--ovr-txt-after-p)))
    (wpers--ovr-kill)))

;; Уничтожаем оверлеи режима во всех буферах кроме текущего
(add-hook 'post-command-hook 'wpers--clean-up-ovrs)


Пропустим «кухню» (аксессоры) и перейдём сразу к изменениям (дополнениям) в публичном интерфейсе модуля:

;; Это свойство определяет способ отображения оверлейных пробелов:
;;  nil - невидимы
;;  t - отображаются в виде маленькой точки по центру символа (символ с кодом 183)
;;  иное число - код символа, который будет отображаться
(defcustom wpers-pspace 32
  :type `(choice (const :tag "Standard visible" t)
                 (const :tag "Invisible" nil)
                 (character :tag "Custom visible"))
  :get 'wpers--get-pspace
  :set 'wpers--set-pspace
  :set-after '(wpers--pspace-def))

;; Функция для включения/выключения оверлейных пробелов - альтернатива custom-ного доступа к wpers-pspace
(defun wpers-overlay-visible (val) "Toggle overlay visibility if VAL is nil, swtich on if t else set to VAL"
  (interactive "P")
  (wpers--set-pspace nil
    (cond
      ((null val) t)
      ((member val  '(- (4))) nil)
      (t val))))

;; Список команд, после выполнения которых без всяких условий overlay must die!
(defcustom wpers-ovr-killing-funs '(undo move-end-of-line move-beginning-of-line) 
  "Functions killing overlay"
  :type '(repeat function))

;; Ассоциативный список каждая пара которого имеет вид (handler . commands)
;; где handler - одна из вышеописанных функций wpers--remap-...
;;     commands - список каждый элемент которого либо непосредственно команда (символ), 
;;                либо список вида (command key) - в этом случае key это строка передаваемая функции kbd
(defcustom wpers-remaps
  '((wpers--remap-vert  next-line previous-line scroll-up-command scroll-down-command
                        (scroll-down-command "<prior>") (scroll-up-command "<next>")) ; for CUA mode
    (wpers--remap-left  left-char backward-char backward-delete-char backward-delete-char-untabify)
    (wpers--remap-right right-char forward-char)
    (wpers--remap-mouse mouse-set-point))
  :options '(wpers--remap-vert wpers--remap-left wpers--remap-right wpers--remap-mouse)
  :type '(alist :key-type symbol :value-type (repeat (choice function (list symbol string))))
  :set 'wpers--set-remaps)


Резюме


Допускаю, что и это решение не лишено недостатков (некоторые я уже вижу), однако в целом прогресс думаю имеет место быть, как в плане практических результатов так и в плане продвижения по пути постижения Дао изучения Emacs ;) Как и прежде (доброжелательные и конструктивные) комментарии ожидаются и приветствуются.

Помимо ранее приведённых гугло-очевидных источников, некоторую полезную информацию почерпнул здесь.