>From c2b5bea92a39f094dbc2cbd07a51feed4d588639 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Thu, 12 May 2022 23:24:47 +0200 Subject: [PATCH] Improve cycle-spacing --- lisp/bindings.el | 2 +- lisp/simple.el | 165 +++++++++++++++++++++++++++++++++++------------ 2 files changed, 124 insertions(+), 43 deletions(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index bfe5ba8623..ed1325e326 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -990,7 +990,7 @@ esc-map (define-key esc-map "\\" 'delete-horizontal-space) (define-key esc-map "m" 'back-to-indentation) (define-key ctl-x-map "\C-o" 'delete-blank-lines) -(define-key esc-map " " 'just-one-space) +(define-key esc-map " " 'cycle-spacing) (define-key esc-map "z" 'zap-to-char) (define-key esc-map "=" 'count-words-region) (define-key ctl-x-map "=" 'what-cursor-position) diff --git a/lisp/simple.el b/lisp/simple.el index 3812f6d8c6..e0f64e3566 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1072,15 +1072,24 @@ delete-horizontal-space "Delete all spaces and tabs around point. If BACKWARD-ONLY is non-nil, delete them only before point." (interactive "*P") + (delete-space--internal " \t" backward-only)) + +(defun delete-all-space (&optional backward-only) + "Delete all spaces, tabs, and newlines around point. +If BACKWARD-ONLY is non-nil, delete them only before point." + (interactive "*P") + (delete-space--internal " \t\r\n" backward-only)) + +(defun delete-space--internal (chars backward-only) (let ((orig-pos (point))) (delete-region (if backward-only - orig-pos + orig-pos (progn - (skip-chars-forward " \t") - (constrain-to-field nil orig-pos t))) + (skip-chars-forward chars) + (constrain-to-field nil orig-pos t))) (progn - (skip-chars-backward " \t") + (skip-chars-backward chars) (constrain-to-field nil orig-pos))))) (defun just-one-space (&optional n) @@ -1088,15 +1097,43 @@ just-one-space If N is negative, delete newlines as well, leaving -N spaces. See also `cycle-spacing'." (interactive "*p") - (cycle-spacing n nil 'single-shot)) + (let ((orig-pos (point)) + (skip-characters (if (and n (< n 0)) " \t\n\r" " \t")) + (num (abs (or n 1)))) + (skip-chars-backward skip-characters) + (constrain-to-field nil orig-pos) + (let* ((num (- num (skip-chars-forward " " (+ num (point))))) + (mid (point)) + (end (progn + (skip-chars-forward skip-characters) + (constrain-to-field nil orig-pos t)))) + (delete-region mid end) + (insert (make-string num ?\s))))) (defvar cycle-spacing--context nil + ;; TODO: Adapt docstring! "Store context used in consecutive calls to `cycle-spacing' command. The first time `cycle-spacing' runs, it saves in this variable: its N argument, the original point position, and the original spacing around point.") -(defun cycle-spacing (&optional n preserve-nl-back mode) +(setq cycle-spacing-actions + '( just-one-space + ;; delete-space-after ; pretty similar to just-one-space. + delete-space-before + delete-all-space + restore)) + +(defun cycle-spacing (&optional n) + ;; TODO: Adapt docstring! + + ;; TODO: We removed the preserve-nl-back and mode args since they + ;; were not used in emacs anyway except by just-one-space + ;; (single-shot) which now has its own impl and cycle-spacing calls + ;; it. What about the `fast' mode value which used to immediately + ;; perform the second step if the first didn't change anything? + ;; IMO, that made sense only when just-one-space was guaranteed to + ;; be the first and "delete all horizontal space" the second... "Manipulate whitespace around point in a smart way. In interactive use, this function behaves differently in successive consecutive calls. @@ -1119,42 +1156,86 @@ cycle-spacing Repeatedly calling the function with different values of N starts a new sequence each time." (interactive "*p") - (let ((orig-pos (point)) - (skip-characters (if (and n (< n 0)) " \t\n\r" " \t")) - (num (abs (or n 1)))) - (skip-chars-backward (if preserve-nl-back " \t" skip-characters)) - (constrain-to-field nil orig-pos) - (cond - ;; Command run for the first time, single-shot mode or different argument - ((or (eq 'single-shot mode) - (not (equal last-command this-command)) - (not cycle-spacing--context) - (not (eq (car cycle-spacing--context) n))) - (let* ((start (point)) - (num (- num (skip-chars-forward " " (+ num (point))))) - (mid (point)) - (end (progn - (skip-chars-forward skip-characters) - (constrain-to-field nil orig-pos t)))) - (setq cycle-spacing--context ;; Save for later. - ;; Special handling for case where there was no space at all. - (unless (= start end) - (cons n (cons orig-pos (buffer-substring start (point)))))) - ;; If this run causes no change in buffer content, delete all spaces, - ;; otherwise delete all excess spaces. - (delete-region (if (and (eq mode 'fast) (zerop num) (= mid end)) - start mid) end) - (insert (make-string num ?\s)))) - - ;; Command run for the second time. - ((not (equal orig-pos (point))) - (delete-region (point) orig-pos)) - - ;; Command run for the third time. - (t - (insert (cddr cycle-spacing--context)) - (goto-char (cadr cycle-spacing--context)) - (setq cycle-spacing--context nil))))) + + ;; Initialize `cycle-spacing--context' if needed. + (when (or (not (equal last-command this-command)) + (not cycle-spacing--context) + (not (= (plist-get cycle-spacing--context :n) n))) + (let ((orig-pos (point)) + (skip-characters " \t\n\r")) + (save-excursion + (skip-chars-backward skip-characters) + (constrain-to-field nil orig-pos) + (let ((start (point)) + (end (progn + (skip-chars-forward skip-characters) + (constrain-to-field nil orig-pos t)))) + (setq cycle-spacing--context ;; Save for later. + ;; Special handling for case where there was no space at all. + (unless (= start end) + (list :orig-pos orig-pos + :whitespace-string (buffer-substring start end) + :n n + :last-action nil))))))) + + ;; Cycle through the actions in `cycle-spacing-actions'. + (when cycle-spacing--context + (cl-flet ((next-action () + (let* ((l cycle-spacing-actions) + (elt (plist-get cycle-spacing--context + :last-action))) + (if (null elt) + (car cycle-spacing-actions) + (catch 'found + (while l + (cond + ((null (cdr l)) + (throw 'found + (when (eq elt (car l)) + (car cycle-spacing-actions)))) + ((and (eq elt (car l)) + (cdr l)) + (throw 'found (cadr l))) + (t (setq l (cdr l))))))))) + (restore (kill-context) + (delete-all-space) + (insert (plist-get cycle-spacing--context + :whitespace-string)) + (goto-char (plist-get cycle-spacing--context + :orig-pos)) + (when kill-context + (setq cycle-spacing--context nil)))) + (let ((action (next-action))) + (atomic-change-group + (if (eq action 'restore) + (restore t) + (restore nil) + (let ((n (plist-get cycle-spacing--context :n))) + (cond + ((eq action 'just-one-space) + (just-one-space n)) + ((eq action 'delete-space-after) + (delete-region (point) + (progn + (skip-chars-forward + (if (< n 0) " \t\r\n" " \t")) + (point)))) + ((eq action 'delete-space-before) + (delete-region (point) + (progn + (skip-chars-backward + (if (< n 0) " \t\r\n" " \t")) + (point)))) + ((eq action 'delete-all-space) + (if (< n 0) + (delete-all-space) + (delete-horizontal-space))) + ((functionp action) + (funcall action)) + (t + (error "Don't know how to handle action %S" action)))) + (setf (plist-get cycle-spacing--context :last-action) + action))))))) (defun beginning-of-buffer (&optional arg) "Move point to the beginning of the buffer. -- 2.36.1