Emacs: we train the cursor (continuation)

Do not be afraid of perfection. You can't reach it!

  Salvador Dali 

Looking into the past

In the previous article , we talked about how you can force the Emacs cursor to maintain its position in a row (column), when going to a shorter string (roughly speaking, getting rid of the "jumps" of the cursor). The proposed solution probably had the only advantage - the utmost simplicity of the code. Let me remind you that for positioning the cursor, additional (extra) spaces were simply used.

More thorough acquaintance with Emacs Lisp and communication with responding knowledgeable people (respect2: Ivan Alekseev aka Yurii Sapfot) reinforced the idea that a better solution should be sought in the direction of overlays . This is how version 2 appeared, which I propose to dear readers.
')

Attempt # 2

Actually, again, the solution is obvious (if there is a certain amount of knowledge): use the before-string property of zero length overlay to position the cursor in the desired position (of course, if the fixed-width font is set).

The general structure of the solution remains the same: it implements minor mode (wpers-mode) within which the basic cursor control commands (next-line, previous-line, left-char, right-char, backward-delete-char-untabify, move -end-of-line, move-beginning-of-line, scroll-up and scroll-down).

In the first variant, we had to add extra spaces, now instead we will simply create a zero-size overlay in the current position and set its before-string property (hereinafter, for simplicity, we will mean this property when speaking about the overlay as a whole) in the line consisting from the required number of spaces (or other characters - see listing).

Further, when the cursor is shuffled within the reach of the overlay (left-right), we will simply adjust the value of this property by increasing or decreasing the line of gaps up to the empty line — in this case, the overlay is simply deleted. If the cursor goes beyond the “influence zone” of the overlay (up and down), then we simply delete it and, if necessary (go up and down on a shorter line), create a new one. Finally, when entering a character (including the same space) after a series of “overlay spaces,” we remove the overlay, “legalizing” all accumulated spaces into real spaces inside the buffer.

The full code of the second version of the package can be obtained from GitHub , here I’ll briefly go through the key fragments, I don’t focus on the details (there is a doc-string and the code is quite compact and transparent).

So let's start with a set of utilities for working with the overlay:

;;         (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)))) 

Now we borrow positioning the cursor in the line:

 ;;      ()      (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)))) 

Next, we define a set of functions for organizing the interception of commands that affect the position of the cursor:

 ;;    ""     (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))) 

Now we define the key "interceptors" called before and after each command:

 ;;     () , 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) 

Let’s skip the “kitchen” (accessors) and go straight to the changes (additions) in the module’s public interface:

 ;;       : ;; 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) 

Summary

I admit that this decision is not without flaws (some I already see), however, in general, I think there is progress, both in terms of practical results and in terms of advancing along the path of learning the Tao of Emacs;) As before (benevolent and constructive ) Comments are welcome and welcome.

In addition to the previously cited Google-obvious sources , I found some useful information here .