Emacs: train the cursor (continued)

No fear of perfection. You will not achieve it!
the

 Salvador Dali

the

Vzglyad in the past

previous article, it was about how to get Emacs the cursor to maintain position in the row (column) when you move to a shorter line (roughly speaking — to get rid of the "jumps" of the cursor). The proposed solution is probably possessed the only advantage is simplicity of code. Recall that to position the cursor just used the extra (unnecessary) spaces.

A more thorough familiarity with Emacs Lisp and communicating with the responding competent people (respect2: Ivan Alekseev, aka Yurii Sapfot) reinforced the idea that a correct solution should be sought in the direction of overleaf. So there is a version # 2 which I suggest dear readers.



the

Try 2

Actually again the solution is obvious (in the presence of certain knowledge): to use this ability before-string overlay zero length to position the cursor to the desired position (of course if you set monotiring the font).

The General structure of the solution remains the same: implemented minor mode (wpers-mode) in which "remipedia" basic commands cursor control (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 version, had to add extra spaces, now instead we will just create in the current position the overlay zero size and set its property before-string (hereinafter for the sake of simplicity, will refer to this property to mention the overlay in General) to a string consisting of the required number of spaces (or other special characters — see listing).

Further, during travel of the cursor within reach of the overlay (left-right) we'll just adjust the value of this property by increasing or decreasing a line of holes up to an empty string — in this case, the overlay is removed. If the cursor is outside the "zone of influence" overlay (up-down), we simply remove it and, if necessary (go up and down on a shorter string), create a new one. Finally, if you enter any character (including a space) after a series of "overlay gaps" we remove the overlay, "legalizing" all the accumulated gaps in the actual gaps inside the buffer.

The complete code for the second version of the package can be obtained with GitHub, here I briefly go over the key fragments, not accent attention to the details (there is a doc-string and the code is quite compact and transparent).

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

the

;; Color overlay with active mode, highlight the current line
(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))

;; Create the overlay the 0-th length in the current position, not forgetting to destroy the same (if any) 
(defun wpers--ovr-make (&optional str) 
(wpers--ovr-kill)
(wpers--setq overlay (make-overlay (point) (point)))
(overlay-put overlay wpers--'t wpers)
(if-str (overlay-put wpers--overlay 'before-string (wpers--ovr-propz-txt str))))

;; Check overlay at the current position of the buffer
(defun wpers--ovr-at-point-p () 
(eq (point) (overlay-start overlay--wpers)))

;; Check for text on the line after the position of the overlay
(defun wpers--ovr-txt-after-p () 
(when wpers--overlay
(let ((ch (char-after (overlay-start overlay--wpers))))
(and ch (not (eq ch 10))))))

;; "Legalization" of the overlay of gaps in the buffer
(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))))

;; The destruction of the overlay with the "legalization" of the gaps if necessary
(defun wpers--ovr-kill ()

(let* ((ov-pos (overlay-start overlay--wpers))
(ch (char-after ov-pos)))
(when (and ch (not (eq ch 10))) (wpers--ovr-to-spcs)))
(delete-overlay overlay--wpers)
(setq wpers--overlay nil)))

;; Destroy the overlays in all buffers except the current one
(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)))

;; Reading the properties before-string 
(defun wpers--ovr-get () 
(overlay-get wpers--overlay 'before-string))

;; Set properties before-string "coloring text" and the ability to perform 
;; any operations on the current value of this property is associated with the variable "_"
(defmacro wpers--ovr-put (val) 
`(let ((_ (wpers--ovr-get)))
(overlay-put wpers--overlay 'before-string (wpers--ovr-propz-txt ,val))))

Now semesa positioning of the cursor:

the

;; the Current position of the cursor in the row (column) taking into account the possible presence of overlay
(defun wpers--current-column () 
(let ((res (current-column)))
(if (and wpers--overlay (wpers--ovr-at-point-p))
(+ res (length (wpers--ovr-get)))
res)))

;; Position the cursor to the desired position inside the string (on screen - not in the buffer!) using overlay
(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)))))

;; Execute an arbitrary expression with preservation of the position of the cursor in the row (column)
(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 the organization of interception of commands affect the cursor position:

the

;; the basic function of creating "wrappers" for commands the cursor
(defun wpers--remap (key body &optional params)
(let ((old (wpers--key-handler key)) ;; remember the current handler
(fun `(lambda ,params ;; new handler
"WPERS handler: perform the operation with saving the current cursor's hotspot position in the line (column)."
,@body)))
(when old (add-to-list 'wpers--funs-alist (cons old fun))) ;; fixed the link the old-new handler
(define-key wpers--mode-map key fun))) ;; set the new handler in keymap mode

;; Wrapper for commands move the cursor vertically
(defun wpers--remap-vert (command &optional key)
(wpers--remap (wpers--mk-key key command) 
`((interactive)(wpers--save-vpos (call-interactively ',command)))))

;; A "wrapper" for "go left"
(defun wpers--remap-left (command &optional key)
(let ((key (wpers--mk-key key command))
(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)))))

;; A "wrapper" for "is right"
(defun wpers--remap-right (command &optional key)
(let ((key (wpers--mk-key key command))
(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)))))

;; Take care of "the brothers"
(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 define key "interceptor" called before and after each command:
the

;; turn Off the mode in the active (activation) level, visual-line-mode or "smeared" lines (truncate-lines nil)
;; NB: read-only now not a hindrance to the  work  mode
(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)))))))

;; Delete overlay if it is one of the conditions:
;; the cursor is not in the position of the overlay
;; - there is text in the buffer after the position of the overlay, but before the end of the line
(defun wpers--post-command-hook ()
(when (and wpers--overlay
(or (not (wpers--ovr-at-point-p))
(wpers--ovr-txt-after-p)))
(wpers--ovr-kill)))

;; Destroy the overlay mode in all buffers except the current one
(add-hook 'post-command-hook 'wpers--clean-up-ovrs)

Skip the "kitchen" (accessors) and go directly to the changes (additions) in the public interface of the module:

the

;; This property determines how to display overlay spaces:

;; t - are shown as small dots in the center of the character (character code 183)
;; otherwise the number of code symbols to be displayed
(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))

;; Function to turn on/off the overlay spaces - an alternative to custom-tion of access to 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))))

;; A list of commands, after which, and without conditions overlay must die!
(defcustom wpers-ovr-killing-funs '(undo move-end-of-line move-beginning-of-line) 
"Killing overlay Functions"
:type '(repeat function))

;; Associative list of which each pair has the form (handler . commands)
;; where handler is one of the above functions wpers--remap-...
;; commands - list each element of which is either directly the command (symbol) 
;; either a list view (command key) - in this case key is a string passed to the function 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)

the

Summary

I admit that this solution is not without its flaws (some of which I already see), but overall I think progress is the place to be, both in terms of practical results and in terms of progress towards cognition of Tao learning Emacs ;) As before (friendly and constructive) comments are expected and welcome.

In addition to the previously mentioned Google, obvious sources, some useful information gathered here.

Article based on information from habrahabr.ru